#!/usr/bin/perl

# Note: currently no one is maintaining this script, since we already
#       have util/smartlinks.pl, which is nicer. :)

# Generate .html from .t and test results 
# Generate cross-referenced html for p6 design docs (optional)
# FIXOTHERS (smoke): t/01-sanity and others have no pos field
# FIXOTHERS (smoke): skipped tests have pos point to the test library

use warnings;
use strict;

use Cwd;
use File::Find;
use File::Spec::Functions ':ALL';
use File::Path;
use File::Basename;
use Getopt::Long;
use IO::File;
use HTML::Template;
use HTML::TreeBuilder;
use HTML::Entities;
use List::Util 'first';
use Regexp::Common qw/balanced delimited/;
use Pod::Simple::HTML;
use Pod::PlainText;
use Tie::RefHash;
use Best 0.05 qw/YAML::Syck YAML/;


$| = 1;
my $start = time;

sub usage {
    my $usage_err = shift;
    my $_PERL6_DOC   =  'http://svn.perl.org/perl6/doc/trunk/';
    my $_PERL6_BIBLE =  'http://tpe.freepan.org/repos/iblech/Perl6-Bible/';
    print <<__HELP__;
$0 - Build html test catalog and synopses with hyperlinks to corresponding tests

  Options:
    --p6design_dir  Directory containing the perl6 design docs apo/exe/syn
    --no_designdocs Do not generate html files for the perl6 design docs (faster)
    --output_dir    Output Directory to put the html files (Default: ./t_index)
    --test_dirs     Directories containing the tests (Default: take tests from ./tests.yml)
    --help          Show this help

  Perl6 Documentation:
    You will need the Synopses checked out; try

    cd ..
    svn co $_PERL6_DOC ../perl6_doc
      or
    svn co $_PERL6_BIBLE ../Perl6-Bible

  Strategy:
    Iterate through all tests first.  Collect links and format as HTML
    as we go.  Then get the design docs, and format those as HTML, linking to 
    the links, and inserting a names where needed.

   Example:
     perl util/catalog_tests.pl --p6design_dir=../p6/docs/design
     perl util/catalog_tests.pl --test_dirs=t/builtins,t/macros --output_dir=t_test --no_designdocs

   See also:
     util/yaml_harness.pl  - produce the data for this tool
     util/testgraph.pl     - Generates an HTML summary of a YAML test run
     util/run-smome.pl     - automate the smoke process

__HELP__

    exit ($usage_err ? 1 : 0);
}

# Input parameters
my $syn_src_dir; # The root directory for perl6 Design POD 
my @t_dirs;      # Test root directories (if used)
my $output_dir;  # The root directory of the output tree.
my $start_dir = cwd;

# ref to hash of information about links that we mean to insert.
# Top level index is file, second level is an array ref of hash refs.
# FIXME: Document next level. ??
my $link_info;
my $total_links;
my $total_files;
my $syn_indexs;
my @syn;

my $help;
my $no_designdocs;
GetOptions('test_dirs=s@' => \@t_dirs,
       'output_dir=s' => \$output_dir,
       'p6design_dir=s' => \$syn_src_dir,
       'no_designdocs' => \$no_designdocs,
        'help' => \&usage) || usage(1);
@t_dirs = split(/,/,join(',',@t_dirs||()));


# Find design doc directory, check
unless($no_designdocs) {
    for ( $syn_src_dir ?
          ($syn_src_dir,catdir($syn_src_dir,'design')) :
          (catdir('..', 'Perl6-Bible', 'lib', 'Perl6', 'Bible'),catdir('..', 'perl6_doc', 'design' ))) {
        $syn_src_dir = $_ and last if -f catfile($_, 'syn', "S12.pod"); 
    };
    unless($syn_src_dir && -f catfile($syn_src_dir, 'syn', "S12.pod"))  {
        print ("*** Could not locate (syn/S12.pod). Setting --no-designdocs.\n");
        $no_designdocs = 1;
    }
}

$output_dir ||= 't_index';
for(@t_dirs) {
    die("Test directory '$_' does not exist. Try --help. ") unless -d $_;
}
$_ = rel2abs($_) for (@t_dirs,$output_dir,$syn_src_dir); 

# Print status
if($no_designdocs) {
    print "P6 design documents   : Won't generate cross-referenced P6 design documents\n";
} else {    
    read_designdocs($syn_src_dir);
    print "P6 design documents   : $syn_src_dir\n";
}
if($#t_dirs >= 0) {
    print "Tests                 : @t_dirs\n";
} else {
    print "Tests                 : Processing tests from tests.yaml\n";
}
print "Output directory      : $output_dir\n";
print "\n";

my $quotable = qr/\w+|$RE{delimited}{-delim=>'"'}/;
my $link     = qr{(.*?)                                     # Leading bit
                  (L <+
                    ($quotable)(?:/($quotable))?             # Normal bit of link 
                        (?:
                          \s+                                   # Whitespace before re
                          $RE{delimited}{-delim=>'/'}{-keep}    # Regex
                          ([xim]*)                              # RE options
                        )?                                      # End of regex block
                      >+)                                       # End of link
                      (.*)                                      # rest of thing
                }sx;
           

my $index = {};
my (@unresolved, @bad_regex, @bad_heading);

# Loading test results from yml file
my $tests = LoadFile("tests.yml");

# Reading and processing .t files
my $files = {}; # mapping from test-file-name to test-record
$files->{$_->{file}} = $_ for @{ $tests->{meat}->{test_files} };

if($#t_dirs < 0) {    
    for(keys %$files) { handle_t_file( catdir(split /\/+/, $_) ); }
} else {
    for(@t_dirs) { find(\&handle_t_file, $_); }
}

# reading synopses
infest_syns($link_info) unless $no_designdocs;

# Generating index.html
my @dirs = sort keys %{$index->{_dirs}};
my $index_file = catfile($output_dir,"index.html");
open( my $fh,'>',  $index_file) or die "Failed to open $index_file: $!";
my $template = HTML::Template->new(filename => 'util/catalog_tmpl/index.tmpl');
my $i = 0;
my $c = int((@dirs+1) / 3)+1;
$template->param(directories => [ map { { title => $_,
                                          wrap  => !(++$i % $c),
                                        }} @dirs ]);
$template->param(updated => localtime() . "");
$template->param(files => $total_files);
$template->param(links => $total_links);
print $fh $template->output();
close $fh;

# Generating design doc index
unless($no_designdocs) { 
    my $syn_index = catfile($output_dir,"Synopsis", "index.html");
    open( $fh, ">",  $syn_index) or die "Failed to open $syn_index: $!";
    $template = HTML::Template->new(filename => 'util/catalog_tmpl/Synopsis.tmpl');

    $template->param("syn", [ sort { $a->{name} cmp $b->{name} } (values %{ $syn_indexs->{S} }) ] ); 
    $template->param("exe", [ sort { $a->{name} cmp $b->{name} } (values %{ $syn_indexs->{E} }) ] ); 
    $template->param("apo", [ sort { $a->{name} cmp $b->{name} } (values %{ $syn_indexs->{A} }) ] );
    print $fh $template->output();
    close $fh;
}

# Generating directory indices
for (@dirs) {
    build_indexes($_, $index->{_dirs}->{$_});
}


# Generating error.html
my $error_file = catfile($output_dir,"error.html");
open( my $error, '>', $error_file) or die "Failed to open $error_file: $!";
$template = HTML::Template->new(filename => 'util/catalog_tmpl/error.tmpl');
$template->param(unresolved => \@unresolved);
print $error $template->output;
close $error;

print "Took: " . (time - $start) . " sec(s)\n";

# read @syn and $syn_indexs
sub read_designdocs {
    my $ddoc_dir = shift;
    @syn = map { m|^.*/(\D\d\d).pod$|; $1 }
        (<$ddoc_dir/apo/*>,
         <$ddoc_dir/exe/*>,
         <$ddoc_dir/syn/*>);
    $syn_indexs = {}; # Table for design documents
    for (@syn) {
        m/^(\D)/;
        $syn_indexs->{$1} ||= {};
        $syn_indexs->{$1}{$_} = 
            {  file => $_ . ".html",
               name => $_,
            };
    }
}

sub build_indexes {
    my $path     = shift;
    my $index    = shift;
    
    return unless exists $index->{_dirs} or exists $index->{_files};
    collapse_isolated_dirs($index);
    
    my $output_path = catfile($output_dir, $path);
    my $index_file =  catfile($output_path,"index.html");
    eval { mkpath( $output_path ) };
    die "Failed to create directory $output_path" if $@;
    open (my $fh,'>', $index_file) or die "Failed to open $index_file: $!";
    my @dirs  = sort keys %{$index->{_dirs}};    

    my @files = (exists $index->{_files} ? sort @{$index->{_files}} : ());
    my $template = HTML::Template->new(filename => 'util/catalog_tmpl/directory.tmpl');
    my $i = 0;
    my $c = int((@dirs+1) / 3) +1;
    $template->param(parent => $index->{_parent} || "../");
    $template->param(directory => $path);
    $template->param(directories => [ map { { 
                                            title => $_,
                                            wrap  => !(++$i % $c),
                                             }} @dirs  ]);    
    $template->param(files       => [sort {$a->{file} cmp $b->{file}} @files ]); 
    print $fh $template->output();
    close $fh;
    for (@dirs) {
        build_indexes( catdir($path, $_), $index->{_dirs}->{$_});
    }
} 

# Note: modfies $index
sub handle_t_file {
  return unless /\.t$/;
  my $input_path    = rel2abs($_);
  my $relative_file = abs2rel($input_path,$start_dir); 

  # Path seperator hack
  my $file_key =  $relative_file;
  $file_key =~ s#\\#/#g;

  $relative_file =~ s/t$/html/;
  
  my $output_path   = inpath_to_outpath($input_path);
  my $path = dirname($relative_file);
  my $file = basename($relative_file);
  my $links = 0;

  mkpath(dirname $output_path);
  
  my $test_results = $files->{$file_key}; 

  my $lines = {};
  for my $test (@{$test_results->{events}} ) {
      next unless defined $test->{pos};
 
      my ($start, $end);
      ($start, $end) = $test->{pos} =~ /line (\d+)(?:.*line (\d+))?/s;
      my @lines;
      if (defined $end && $end > 0) {
         @lines = $start .. $end;
      } else {
         @lines = ($start);
      }
      next unless $start;
      for my $line (@lines) {
          if (exists $lines->{$line}) {
              $lines->{$line} = 0 if $test->{ok}||0 == 0;
          } else { 
              # skipped tests do not carry the a line number, so leave them out for now
          if($test->{todo}||0 == 1) {
          $lines->{$line} = 2;
          } else {
          $lines->{$line} = ($test->{ok}||0 ==1 ? 1 : 0);
          }
          }
      }
  }
                                                                                           
  my $infile  = IO::File->new($input_path, "<:utf8") 
                         or die "Can't open input test file $input_path: $!";
  my $outfile = IO::File->new($output_path, ">:utf8")
                         or die "Can't open output test file $output_path: $!";
                         
  my $template = HTML::Template->new(filename => catdir $start_dir, 
                     'util','catalog_tmpl','code.tmpl');  
  $template->param("file" => $file);
  my $output = ""; 
  
  while (my $rest = <$infile>) {
    chomp $rest;
    $output .= "<a name='line_$.'></a>";
    while ( $rest =~ $link ) { 
      my $text = $1;
      my $whole = $2;
      my $linkfile = $3;
      my $linkhead = $4;
      # $5  captures the entire match
      # $6  captures the opening delimiter (provided only one delimiter was specified)
      my $regex    = $7; 
      # captures delimited portion of the string (provided only one delimiter was specified)
      # $8  captures the closing delimiter (provided only one delimiter was specified)
      my $reopts   = $9;
      $rest        = $10;
      
      $linkfile = $1 if ($linkfile =~ /^"(.*)"$/);
 
      if ($linkfile =~ /^http/) {
        $output .= "$text <a href='$linkfile'>$whole</a>";
        $links++;
        next;
      }
      
      $linkhead = $1 if ($linkhead =~ /^"(.*)"$/);
#     $body->push_content(HTML::Element->new('pre')->push_content($text));
      
      my $link = {};
      $link->{linkfile} = $linkfile;
      $link->{linkhead} = $linkhead;
      $link->{whole}    = $whole;
      $link->{relfile}  = $relative_file;
      if ($regex) {
        $reopts||='';
        $link->{regex} = eval "qr/$regex/$reopts";
      }
      $link->{sourcepath}=$output_path;
      $output .= $text;
      my $syn_path = catfile($output_dir, "Synopsis", "$linkfile.html");
      $output .= "<a href='". abs2rel($syn_path, dirname($output_path)) . "#" .(0+$link) . 
                    "' id='" . (0+$link) . "'>" . encode_entities($whole) . "</a>";
      push @{$link_info->{$linkfile}}, $link;
      $links++;
    }
    
    if ($rest) {
       $rest = encode_entities($rest);
#      $body->push_content($rest);
      my $test_class = {
                      0 => 'test_fail',
                      1 => 'test_pass',
                      2 => 'test_todo',
                      3 => 'test_skip',
                    };
      my $class = 'non_test';
      if (exists $lines->{$.}) {
        $class = $test_class->{$lines->{$.}};
      }
      $output .= "<span class='$class'>$rest</span>";
      
    }
#    $body->push_content("\n");
     $output .= "\n";
  }
  $template->param("tests", $output);
  my $tres = $test_results->{results};
  my $data = { 
        file   => $file, 
        links  => $links,
        ok     => $tres->{ok} - $tres->{todo} - $tres->{skip},
        todo   => $tres->{todo},
	skipped   => $tres->{skip},
        failed => ($tres->{seen} || 0) -
              ($tres->{ok} || 0)
  };
  my (@paths) = splitdir($path);
  my $loc  = 'push @{$index';
  $loc .= "->{_dirs}->{'" . $_ . "'}" for @paths;
  $loc .= "->{_files}} , \$data";
  eval $loc;
  warn "*** Unfortunately $path will not be available in the index (eval $loc failed: $@)" if $@;
  $total_links += $links;
  $total_files++;
  $outfile->print($template->output);
}

sub infest_syns {
    my $index = shift;

    my $p = Pod::PlainText->new(width => 1000);

    mkpath(my $syndir = catdir($output_dir, "Synopsis"));
    
    for my $syn (@syn) {
        # create HTML out of the pod
        
        my $synhtml = catfile($syndir     , "$syn.html");
        my $synpod  = catfile($syn_src_dir, "$syn.pod" );
        unless ( -f $synpod ) {
            if    ( $syn =~ /^S/i ) { $synpod = catfile($syn_src_dir, 'syn', "$syn.pod"); }
            elsif ( $syn =~ /^A/i ) { $synpod = catfile($syn_src_dir, 'apo', "$syn.pod"); } 
            elsif ( $syn =~ /^E/i ) { $synpod = catfile($syn_src_dir, 'exe', "$syn.pod"); } 
        }
        Pod::Simple::HTML->parse_from_file($synpod, $synhtml);
        
        # and parse it into a tree
        my $sobj = HTML::TreeBuilder->new_from_file($synhtml);

        # this makes it prettier
        $sobj->look_down(_tag=>"head")->push_content(
                HTML::Element->new("link", rel  => "stylesheet", 
                                           type => "text/css", 
                                           href => "http://dev.perl.org/css/perl.css"
                                   ));
        if (exists $index->{$syn}) {
        # This makes later processing easier
        $sobj->objectify_text;

        for my $headlevel (reverse 1..7) {
          my $tag = 'h'.$headlevel;
          
          while (my $beg = $sobj->look_down(_tag => $tag)) {

            my $beg_n = $beg->pindex;
            my $end   = $beg->right;
            
            if (!defined $end) {
              $beg->tag('div');
              $beg->attr('class', 'empty_head '.$tag);

              next;
            }

            $end = $end->right until (!$end->right or $end->right->tag eq $tag);
            
            my $end_n = $end->pindex;

            my $name = join '', 
              map {$_->attr('text')} 
                $beg->look_down(_tag=>'~text');

            $name = $1 if $name =~ m/^"(.*)"/;

            my $div = HTML::Element->new('div', class=>$tag, name=>$name);
            
            my @kids = $beg->parent->splice_content($beg_n, $end_n-$beg_n+1, $div);
            $div->push_content(@kids);
            $kids[0]->tag('div');
          }
        }
        
        $sobj->deobjectify_text;

        tie my %sup_links, 'Tie::RefHash';
        foreach my $link (reverse @{ $index->{$syn} }){
          # reverse is since we're splicing right after the h1
            my $target  = $link->{linkfile};
            my $heading = $link->{linkhead};
            my $source  = $link->{sourcepath};
            my $regex   = $link->{regex};

            # create a representation that is like the $html->as_text
            $heading = $p->interpolate($heading);
            $heading =~ s/^\s+|\s+$//g;;
            $heading =~ tr/`'//d; #`# DELME: emacs repair

            if ($heading) {
                my $heading_re = qr/^\Q$heading\E$/i;

#               print STDERR "Trying to get heading >$heading<\n";

                my $h = $sobj->look_down( _tag  => 'div', 
                                          class => qr/^h\d$/,
                                          name  => $heading_re);
                
                unless ($h) {
                    push @unresolved, { target   => $target, 
                                        heading  => $heading,
                                        relative => $link->{relfile} };
                    next;
                };

                # create the backlink <a href...>
                my $backlink = HTML::Element->new('a', 
                         href  => (abs2rel($source, dirname($synhtml)) . "#" . 
                                  (0+$link)), id=>0+$link, 
                         title => $link->{whole},
                         class => 'testlink');
                # $backlink->push_content(abs2rel($source, $output_dir));
                $h->push_content($backlink);
                my $t = HTML::Element->new('sup');
                $t->push_content('T');
                $backlink->push_content($t);
                my $syn_ref = $syn_indexs->{ substr($syn,0,1) }{$syn};
                $syn_ref->{tests}++;

                my $found;
                if ($regex) {
                    # we're skipping forward till we find a regex
                    my @stuff = $h->look_down(sub {$_[0]->as_text =~ $regex});
                    if (!@stuff) {
                      goto notregex;
                    }
                    # Prefer deeper or earlier matches.
                    @stuff = sort {$b->depth   <=> $a->depth    or
                                   $a->address cmp $b->address
                                  } @stuff;

                    $h = $stuff[0];
                    
#                   $h->dump(\*STDERR);

                    my $i=-1;
                    foreach ($h->content_list) {
                      $i++;
                      next if ref $_;
                      next unless /(.*)($regex)(.*)/;
                      
                      $h->splice_content($i, 1, $1, $2, $backlink, $3);
                      $found = 1;
                      last;
                    }

                    if (!$found) {
                      # Part of the content is inside a pre.
                      $h->push_content($backlink);
                      $found = 1;
                    }
                  }
                
              notregex:
                # insert just a normal link, after the header, when there is no regex
                # or if the regex failed
                unless ($found) {
                  push @bad_regex, { regex   => $regex,
                                     target  => $target,
                                     heading =>  $heading, 
                                     source  => $source } if $regex;
                  ($h->content_list)[0]->push_content($backlink);
                }
                

              } else {
                # perhaps L<S02> etc should just link to the top?
                # this is what you get at the moment
                push @bad_heading, "link in $source to $target does not have a heading\n";
              }
            
          }
        }
        # finally, write out the synopsis
        my $outfile = IO::File->new(">$synhtml") 
                             or die "Can't open output test file $synhtml: $!";
        $outfile->print($sobj->as_HTML(undef, ' ', {}));
    }
}

# calculate output path of a test files
sub inpath_to_outpath {
    my $inpath  = shift;
    my $outpath = abs2rel($inpath, $start_dir); 
    $outpath    = rel2abs($outpath, $output_dir);
    $outpath    =~ s/\.t$/\.html/;
    return $outpath;
}


# Takes one hash argument which is modified
# try to 'collapse' useless directory entries
sub collapse_isolated_dirs {
    my $dir_index = shift;
    # For all directory entries: while the entry only has one subdirectory and no files, collapse
    for my $subdir (keys %{$dir_index->{_dirs}}) {
	my $val = $dir_index->{_dirs}->{$subdir};
	while( ( exists $val->{_dirs} && scalar %{$val->{_dirs}}||0 == 1 ) &&  ! exists $val->{_files} ) {
	    my $subsubdir = (keys %{$val->{_dirs}})[0];

	    # Update the argument
	    delete $dir_index->{_dirs}->{$subdir};	    
	    $dir_index->{_dirs}->{$subdir . "/" . $subsubdir } = $val->{_dirs}->{$subsubdir};	    
	    $val->{_dirs}->{$subsubdir}->{_parent} = ($val->{_parent} || "../")  . "../";
	    $val = $val->{_dirs}->{$subsubdir};	    
	}
    }
}
