2.9BSD/bin/utree.pl

#!/usr/bin/perl
use strict;
use warnings;
use lib '/usr/local/unixtree';
use UnixTree::Controller;
use CGI;
use Template;    # Template Toolkit module
#use Data::Dumper;

# Create a new template object, setting the directory where
# the template documents are stored.
my $template =
  Template->new( { INCLUDE_PATH => '/usr/local/unixtree/templates', } );

# Create a new CGI object. Do it before the subroutines,
# so they know of its existence.
my $query = new CGI;

# Something went wrong, print out some details
sub error {
    my ($error)   = @_;              # Get the error argument
    my $templfile = 'error.html';    # Template file to use
    my $vars      = {                # Initialise variables to use
        'title' => 'Error',
        'error' => $error,
        'cgi'   => $query            # Reference to the $query object
    };

    # Print out the template file, filling in the variable placeholders
    $template->process( $templfile, $vars ) || die $template->error();
    exit(0);
}

# Print out the details for a directory
sub print_dirDetails {
    my ($dir) = @_;
    my $introduction = "";
    my ( $fileref, $indexhtml ) = get_FilesAt($dir);

    if ($indexhtml) {
        $introduction = join( "", get_File("$dir/index.html") );
    }

    my $templfile = 'dirlisting.html';    # Template file to use
    my $vars      = {                     # Initialise variables to use
        'dirname'      => $dir,
        'introduction' => $introduction,
        'filelist'     => $fileref,
        'cgi'          => $query           # Reference to the $query object
    };

    # Print out the template file, filling in the variable placeholders
    $template->process( $templfile, $vars ) || die $template->error();
    exit(0);
}

# Print out details for a file
sub print_fileDetails {
    my ($file) = @_;

    # Get the lines of the file, and escape any HTML characters
    my @newlines = map( { CGI::escapeHTML($_) } get_File($file) );

    # Get a list of similar files
    my @simlist = get_SimilarFiles($file);
    my $anysims = @simlist;

    my $templfile = 'filelisting.html';    # Template file to use
    my $vars      = {                      # Initialise variables to use
        'filename' => $file,
        'lines'    => \@newlines,
        'simlist'  => \@simlist,
        'anysims'  => $anysims,
        'cgi'      => $query               # Reference to the $query object
    };

    # Print out the template file, filling in the variable placeholders
    $template->process( $templfile, $vars ) || die $template->error();
    exit(0);
}

sub print_topLevel {

    # Get known releases
    my $relhref = get_Releases();

    # Get the release groups
    my @reltags= get_Releasetags();

    # Build an array of releases
    my @rellist;
    foreach my $r ( keys( %{$relhref} ) ) {
        push( @rellist, $relhref->{$r} );
    }

    # Now build a list sorted by the date
    my @sortlist = sort( { $a->{date} cmp $b->{date} } @rellist );

    my $templfile = 'toplevel.html';    # Template file to use
    my $vars      = {                   # Initialise variables to use
        'releaselist' => \@sortlist,
        'reltags'     => \@reltags,
        'cgi'         => $query         # Reference to the $query object
    };

    # Print out the template file, filling in the variable placeholders
    $template->process( $templfile, $vars ) || die $template->error();
    exit(0);
}

sub print_filecompare {
    my ( $file1, $file2 ) = @_;
    my @colourlist = (
        'f6cabc',                       # Pink
        'bcbdf6',                       # Light blue
        'c6f6bc',                       # Light green
        'f9c791',                       # Light orange
        'eabbf8',                       # Lilac
        'f8f4bb',                       # Light yellow
        'ddf8bb',                       # Lime
        'dbdbdb'                        # Grey
    );
    my %f1colour;                       # per-line colors for file1
    my %f2colour;                       # per-line colors for file1

    # Get the list of similarities
    my $simlistref = get_SimilaritiesBetween( $file1, $file2 );
    my $anysims = @{$simlistref};

    # Set a colour for the lines in each similarity
    my $index = 0;
    foreach my $sim ( @{$simlistref} ) {
        for ( my $num = $sim->{srcline1} ; $num <= $sim->{srcline2} ; $num++ ) {
            $f1colour{$num} = " style=\"background:#$colourlist[$index]\"";
        }
        for ( my $num = $sim->{dstline1} ; $num <= $sim->{dstline2} ; $num++ ) {
            $f2colour{$num} = " style=\"background:#$colourlist[$index]\"";
        }
        $index++;
        $index = 0 if ( $index >= @colourlist );
    }

    # Get the lines of file1, and escape any HTML characters
    my @newlines = map( { CGI::escapeHTML($_) } get_File($file1) );

    # Build an array of hashes for the lines, with each hash holding:
    #	num: a 4-digit line number
    #	line: the actual line
    my @file1lines;
    my $num = 1;
    foreach my $line (@newlines) {
        my $href = {
            num  => sprintf( "%04d", $num ),
            line => $line,
            style => $f1colour{$num} ? $f1colour{$num} : ""
        };
        push( @file1lines, $href );
        $num++;
    }

    # Do exactly the same for the second file
    @newlines = map( { CGI::escapeHTML($_) } get_File($file2) );

    # Build an array of hashes for the lines, with each hash holding:
    #	num: a 4-digit line number
    #	line: the actual line
    my @file2lines;
    $num = 1;
    foreach my $line (@newlines) {
        my $href = {
            num  => sprintf( "%04d", $num ),
            line => $line,
            style => $f2colour{$num} ? $f2colour{$num} : ""
        };
        push( @file2lines, $href );
        $num++;
    }

    # Set the template file to use
    my $templfile =
      defined( $query->param('print') )
      ? 'printsimilarities.html'
      : 'showsimilarities.html';
    my $vars = {    # Initialise variables to use
        'simlist'    => $simlistref,
        'anysims'    => $anysims,
        'file1'      => $file1,
        'file2'      => $file2,
        'file1lines' => \@file1lines,
        'file2lines' => \@file2lines,
        'cgi'        => $query          # Reference to the $query object
    };

    # Print out the template file, filling in the variable placeholders
    $template->process( $templfile, $vars ) || die $template->error();
    exit(0);
}

##################
## MAIN PROGRAM ##
##################

# Print the content type:
print $query->header('text/html');

# If there are no fields filled in, run the subroutine
# to generate the form.
if ( !$query->param ) { print_topLevel(); }

# If they want details of a file or dir
if ( defined( $query->param('file') ) ) {

    # Get known releases
    my $relhref = get_Releases();

    # Get the file and the top-level
    my $file = $query->param('file');
    my $top  = $file;
    $top =~ s{/.*}{};

    # If top is not a known release, error
    error("$file not in a known release") if ( !defined( $relhref->{$top} ) );

    # If it's a directory
    if ( isDir($file) ) {
        print_dirDetails($file);
    }
    else {
        print_fileDetails($file);
    }
}

# If they want to compare two files
if ( defined( $query->param('file1') ) ) {
    error("You did not tell me the name of the second file!")
      if ( !defined( $query->param('file2') ) );
    print_filecompare( $query->param('file1'), $query->param('file2') );
}

error("Seems like I don't know how to handle your request.");
exit(0);