package highlight_method;

use strict;
use CGI qw(escapeHTML);

use Syntax::Highlight::Perl;

my %ct = qw(
  Variable_Scalar   080 Variable_Array    f70 Variable_Hash     80f Variable_Typeglob f03
  Subroutine        980 Quote             00a String            00a Bareword          3A3
  Package           900 Number            f0f Operator          000 Symbol            000
  Keyword           000 Builtin_Operator  300 Builtin_Function  001 Character         800
  Directive         399 Label             939 Line              000
  Comment_Normal    069;background-color:#eee Comment_POD       014;background-color:#eee
);

my $formatter = Syntax::Highlight::Perl->new();

$formatter->define_substitution(qw(< &lt; > &gt; & &amp;)); # HTML escapes.

# install the formats set up above
foreach(keys %ct){
  $formatter->set_format($_, [ qq(<span style="color:#$ct{$_}">),'</span>' ] );
}

print "Content-type: text/html\n\n";

### Split the method name from the module;
(my $path_info = $ENV{'PATH_INFO'}) =~ s/^\///;
my( $module, $method ) = $path_info =~ /^(.*)::(.*)/;
unless( $module ) {
  printf "<p>String supplied in URL is invalid</p>", $path_info;
  exit;
}

### If not a valid module name then throw an error...
unless( $module =~ /^[a-zA-Z_]\w*(::\w+)*$/ ) {
  printf "<p>Invalid module name %s</p>", escapeHTML( $module );
  exit;
}

### Search for file in directory tree (@INC)
(my $file = $module) =~ s/::/\//g;
my $fullfile = '';

foreach my $dir (@INC) {
  next if $dir =~ /sanger-plugins/;
  $fullfile = "$dir/$file.pm";
  if( -e $fullfile) {
    last;
  }
  $fullfile = '';
}

### If does not exist - throw error...
unless( $fullfile ) {
  printf "<p>Unable to find module %s</p>", escapeHTML( $module );
  exit;
}

### Open the file
my $flag = !$method;
my $out = '';
open I, "<$fullfile";
while(<I>) {
  if(/^\s*sub\s*(\w+)/ && $method) {
    $flag = $1 eq $method;
  }
  if( $flag ) {
    $out .= $formatter->format_string($_) unless /^\s*###/ && $method;
  }
}
$out =~ s/\n\s+\n/\n/g;
unless( $out ) {
  printf "<p>Unable to find method %s in module %s</p>", escapeHTML( $method ), escapeHTML( $module );
  exit;
}

printf qq(
<pre style="font-size:10pt;color:#336;">
%s
</pre>), $out;

1;
