#!/usr/bin/perl

use strict;
use warnings;

use HTML::Template;
use HTML::Entities;
use PPI;
use PPI::HTML;
use Data::Dumper;

die "script needs at least one file to process!\n" unless @ARGV;

my @content;
my $template    = HTML::Template->new(filename => "container2.html");

foreach my $source (@ARGV) {
    my ($type) = $source =~ /\.(.*)$/;
    my $part;
    
    open(FILE, '<', $source) or 
        die "dieing while trying to open $source cause of: $!\n";
    
    my $native = join '', (<FILE>);
    if ($type eq 'pl') {
        my $perldoc     = PPI::Document->new( \$native );
        my $highlight   = PPI::HTML->new(); 
        $part           = $highlight->html( $perldoc ); 
    } else { 
        $part = encode_entities($native); 
    }
    close(FILE);

    push @content, { 
        source  => $source,
        content => $part,
        type    => $type,
    }; 
}

$template->param( content   => \@content, );
print generate_links($template->output());

sub generate_links {
    my $raw = shift;
    my @keywords = qw(
       bless close closedir die shift eval exit grep map open opendir print
       splice split sysopen warn each values atan2 bind binmode caller chdir
       chmod chomp chop chown chr chroot cmp connect continue cos crypt
       dbmclose dbmopen defined delete dump endgrent endhostent endnetent
       endprotoent endpwent endservent eof eq exec exists exp fcntl fileno
       flock fork format formline getc getgrent getgrgid getgrnam
       gethostbyaddr gethostbyname gethostent getlogin getnetbyaddr
       getnetbyname getnetent getpeername getpgrp getppid getpriority
       getprotobyname getprotobynumber getprotoent getpwent getpwnam getpwuid
       getservbyname getservbyport getservent getsockname getsockopt glob
       gmtime goto ge hex import index int ioctl join keys kill last lc
       lcfirst length le link listen localtime log lstat mkdir msgctl msgget
       msgrcv msgsnd next ne no no oct or ord pack pipe pop pos q qq quotemeta
       qw qx read readdir readlink readpipe recv redo ref rename reset reverse
       rewinddir rindex rmdir scalar seek seekdir select semctl semget semop
       send setgrent sethostent setnetent setpgrp setpriority setprotoent
       setpwent setservent setsockopt shift shmctl shmget shmread shmwrite
       shutdown sin sleep socket socketpair sort split sprintf printf sqrt
       srand rand stat shift study substr switch symlink syscall sysread
       system syswrite tell telldir time times tr truncate uc ucfirst umask
       undef unlink unpack unshift untie utime vec wait waitpid wantarray
       write xor
    );
    
    for my $keyword (@keywords) {
        $raw =~ s/\<span class=\"word\"\>$keyword\<\/span\>/\<span class=\"word\"\>\<a href=\"http:\/\/perldoc.perl.org\/functions\/$keyword.html\"\>$keyword\<\/a\>\<\/span\>/;
    }    
    return $raw;
}