package Framework;
#!/usr/bin/perl -w
# In nomine Ad Signo, et Percentus, et Dollar Signo Sancti. Amen.


use strict;
require Exporter;
use Template;
use DBI;
use CGI::Carp qw(fatalsToBrowser);
use CGI qw(:all);
use constant DEBUG => 0;
use vars    qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use vars    qw($defaultpage $Current_Page  %pages);
my $vars;
my $errorlevel;

@ISA         = qw(Exporter);
@EXPORT      = qw(%pages &InsertPage_hashref &InsertPage_arrayref &RunPages $defaultpage &dump_struct
                  &set_errorlevel &get_errorlevel &set_var &get_var);

#
#   inserts a page into the hash via an array.
#   
#
sub InsertPage_arrayref ($) {
    my @_parms=@{@_[0]};
    #   Make sure there's the right # of keys to do the job.
    if (scalar @_parms == 11) {
        unless ($defaultpage) {$defaultpage = $_parms[0]};
        if (defined $_parms[1]){ load_lib ($_parms[1],"main")};
        $pages {$_parms[0]} = {
            description     =>  $_parms[1],
            traverse_list   =>  $_parms[3],
            traverse_sub    =>  $_parms[4],
            validator       =>  $_parms[5],
            errorhandler    =>  $_parms[6],
            template        =>  $_parms[7],
            preprocess      =>  $_parms[8],
            postsubmit      =>  $_parms[9],
            params          =>  $_parms[10],
        }
    } else {
        die "wrong number of elements passed to InsertPage_arrayref. Expected 11, got ". (scalar @_parms)
    }
}

#
#   inserts a page into the %pages hash via a hash.
#
#
sub InsertPage_hashref ($) {
    my %_parms= %{@_[0]};
    #   Make sure there's the right keys to do the job.
    if (CheckKeys (\%_parms,["pagename","description","traverse_list",
                         "traverse_sub","validator","errorhandler",
                         "template","preprocess","postsubmit","params"])) {
                             
        #
        #   ok, all the parameters are there, what about the default page?
        #
        #
        unless ($defaultpage) {$defaultpage = $_parms{pagename}};
        
        #
        #   check to see if we should load a module for this page.
        #
        #
        if (defined $_parms{module}){ load_lib ($_parms{module},"main")};
        
        
        
        #eval "require \"$_parms{module}\""|| die "no module";
        $pages {$_parms{pagename}} = {
            description     =>  $_parms{description  },
            traverse_list   =>  $_parms{traverse_list},
            traverse_sub    =>  $_parms{traverse_sub },
            validator       =>  $_parms{validator    },
            errorhandler    =>  $_parms{errorhandler },
            template        =>  $_parms{template     },
            preprocess      =>  $_parms{preprocess   },
            postsubmit      =>  $_parms{postsubmit   },
            params          =>  $_parms{params       },
        }
    }
}

#
#   Checks a hash to make sure a set of keys exist.
#
#
sub CheckKeys (\%\@)  {
    my %hash = %{$_[0]};
    my @keys = @{$_[1]};
    foreach (@keys) {
        if (! exists ($hash{$_})) { return 0}
    }
    return 1;
}

#
#   This sub is the meat of this module...
#   it uses information to display HTML pages from 
#   %pages. Verifies parameters, and contains logic to
#   perform pre and post display functions.
#
#


sub RunPages {
    print header (-type=>'text/html');   
    print start_html;
    print start_form;   # remember that all hidden fields need to be withinthe form, they're input!

    debugprint ( "checking Current_page ".br);

    #
    #   separate into sub
    #
    #
    
    #
    #   Current_Page is a parameter that will be set immediately before a page is displayed.
    #   Inside of the program, it is analogous to $Current_Page, and is used to determine 
    #   what set of subroutines should be run.
    #   If param ("Current_Page") exists, that means that the user's CGI script has run through at least once.
    #   We'll grab it's contents and stuff it into $Current_Page.
    #   But if param ("Current_Page") doesn't exist, then we set $Current_Page to the 
    #   contents of $defaultpage, which is typically the first page inserted.
    #   Note that $defaultpage is exported, so that users can set it to whichever page they prefer.
    #   to display as their first.
    #

    if  (param ("Current_Page")){
        debugprint ("found Current_page set to ".param ("Current_Page").br);
        $Current_Page =  param ("Current_Page");
        debugprint ("Checking Current_Page for validator<BR>");
    
    #
    #   Here, we are checking to see if the current page has a validator defined.
    #   If it does, run it and store the result in $errorlevel.
    #   $errorlevel is then passed to all other subs as a way of determining state.
    #
        if (defined ($pages{$Current_Page}{validator})) {
            $errorlevel =$pages{$Current_Page}{validator}->();
            debugprint ("validator found, returned '$errorlevel'.<BR>");
        }
    } else {
        debugprint( "setting Current_Page to default page $defaultpage<BR>");
        $Current_Page =  $defaultpage;
    
    }


    debugprint ("printing parameters<BR>");


    #
    #   Here we go through each page, and see what its params are.
    #   Note that I rarely use param lists, so I only write each
    #   parameter's last value.
    #   This prevents duplication of parameters when pages refer back
    #   to themselves.
    #   I consider this to be a problem, but I'm not sure how to fix it :|
    #
    
    foreach my $thispage (keys %pages){
            foreach (@{$pages{$thispage}{params}}) {
                debugprint ("looking at param $_");
                my @temp_param = param($_);
                if ((param($_))){print hidden ($_, $temp_param[-1])}
                $$vars{params}{$_}= $temp_param[-1];

                debugprint ("Parameter '$_' set to '$temp_param[-1]'<BR>");

            }
    }
    debugprint ("Done printing parameters<BR>");

    debugprint ("Checking traversal list<BR>");
    my $nextpage;




    #
    #   Here we check the current page's traversal list.
    #   As a default, if it has no traverse_sub, it'll loop back to $Current_Page.
    #   Right now, the traverse_sub is called with references to $vars and $errorlevel, but
    #   this should be unneeded with the introduction of (get|set)_(var|errorlevel|param)
    #   I'm leaving it in right now.
    #
    #   As a side effect of the order of processing things, it becomes convenient to
    #   check for param("Current_Page") in the default page's validator, and have it return itself
    #   if param("Current_Page") doesn't exist.
    #
    if ($pages{$Current_Page}{traverse_sub} ne "") {
        debugprint ("Traversal list found... <BR>");
        $nextpage = $pages{$Current_Page}{traverse_sub}->(\$vars,\$errorlevel);
    } else {
        debugprint ("No traverse_sub for page 'Current_Page'. Are you sure about that? Setting next_page to 'Current_Page'");
        $nextpage = $Current_Page;
    }
    
    debugprint ("Traverse_sub  returns '$nextpage'<BR>");

    #   
    #   Paranoia?
    #
   
    if (defined $nextpage) {
        #
        #   make sure that $nextpage is in the current page's traverse list.
        #   
        unless (defined ($pages{$Current_Page}{traverse_list}{$nextpage})){
            debugprint ("tried to access undefined key in $Current_Page traverse_list : $nextpage");
            #die;
        }

        
        #
        #   SO we survived that.
        #   Now we check the value of $nextpage 's entry in traverse_list.
        #   If it's true, we check for and execute $Current_Page's postsubmit.
        #
        debugprint ("Checking for '$Current_Page' traverse for post submit <BR>");
        if ($pages{$Current_Page}{traverse_list}{$nextpage}){
            if (defined $pages{$Current_Page}{postsubmit}) {
                debugprint ("Executing '$Current_Page' post submit<BR>");
                $pages{$Current_Page}{postsubmit}->(\$vars, \$errorlevel);
                debugprint ("Done with '$Current_Page' post submit<BR>");
            } else {
                debugprint ("No post submit found, but traversal post submit set to 1!<BR>");
            }
        } else {
            debugprint ("No post submit found, but traversal post submit set to 1!<BR>");
        };

        #
        #   OK.
        #   At this point in the game, the previous page has been displayed, 
        #   or the default page has been queued up.
        #
        #
        
        debugprint ("Setting Current_Page to '$nextpage'<BR>");
        $Current_Page = $nextpage;
    }   else    {
        debugprint ("Nextpage is not defined... what happened here?<BR>");
    }

    
    #
    #   These are 4 special vars that will get loaded for any page.
    #   $$vars{pagetitle} is a reference to the description, I use
    #   it to define titles in my html templates. 
    #   Will probably go away once I come to my sense.
    #
    #   $$vars{current_page} is used to drive the RunPages subroutine.
    #   very much needed.
    #
    #   $$vars{error_level} is a way to pass the errorlevel onto the
    #   HTML templates. This way you can have blocks like :
    #   [% IF error_level %] Don't do that again! [% END %]
    #   and so on.
    #
    #   related to this is get_bit, which really should be unnecessary, but 
    #   I can't seem to get tt2 to recognize bitwise ops.
    #   having get_bit available to the HTML Template will allow users
    #   to define bitflags in their errorcodes and check for them in 
    #   templates.   
    #

    debugprint ("Setting \$\$vars info<BR>");
    $$vars{pagetitle}   =$pages{$Current_Page}{description};
    $$vars{current_page}= $Current_Page;
    $$vars{error_level} = $errorlevel;
    $$vars{get_bit}=sub {if ($_[0] && $_[1]){return ((scalar shift) & (scalar shift))}}; # why doesn't TT2 recognize bitwise ops? :(

    debugprint ("Hiding current_page -- $Current_Page<BR>");
    param('Current_Page',$Current_Page);
    print hidden ("Current_Page", $Current_Page);


    debugprint ("Setting Template<BR>");
    debugprint ("Checking for preprocess sub<BR>\n");


    #
    #   And now prepare to do any preprocessing for the real current page.
    #
    if (defined $pages{$Current_Page}{preprocess}) {
        $pages{$Current_Page}{preprocess}->(\$vars, \$errorlevel);
    } else {
        debugprint ("no preprocess sub found<BR>\n");
    }
    #
    # show the template
    #
    my $template;
    $template= Template->new() || die( "Can't create template $!");
    $template->process($pages{$Current_Page}{template}, $vars)|| die ("Template process failed: ", $template->error(), "\n");
    debugprint ("<BR>Done printing template<BR>\n");
    debugprint ("Cleaning up<BR>");
    print end_form;
    print end_html;
}



sub set_errorlevel {
    $errorlevel = $_[0];
}

sub get_errorlevel {
    return $errorlevel;
}

sub set_var {
    my $_key = shift;
    my $_val = shift;
    print "setting \$\$vars {$_key} to $_val";
    $$vars {$_key} = $_val;
}

sub get_var {
    if (exists $$vars{$_[0]}) 
        {return \$$vars{$_[0]}}
    else
        {return undef}
}

sub get_param {
    if (exists $$vars{params}{$_[0]}) 
        {return \$$vars{params}{$_[0]}}
    else
        {return undef}
}

sub set_param {
    $$vars{params}{$_[0]}
}


#
#this will print an html table showing
# the structure of the assembled %pages
#   currently broken for pages that have
#   recursive references. :(
#
#
sub dump_struct{

    my $cp = $defaultpage;
    print "<CENTER>";
    print "<TABLE BORDER=1>";
    print "<TH>Page Name</TH><TH>children</TH><TH>Verified?</TH>";
    dump_line ($cp);
    print "</TABLE>";
}

sub dump_line{
    my $cp=shift;
        if (keys %{$pages{$cp}{traverse_list}}){
            foreach (sort keys %{$pages{$cp}{traverse_list}}) {
                print "<TR><TD>$cp</TD><TD>", ($_ eq $cp)?"<I>self</I>":$_,"</TD><TD>",
                      $pages{$cp}{traverse_list}{$_}?"yes":"no","</TD>";
            }
            foreach (sort keys %{$pages{$cp}{traverse_list}}) {
                unless ($_ eq $cp) {dump_line ($_)}
            }
        } else {
            print "<TR><TD>$cp</TD><TD COLSPAN=3>no children</td>";
    }

}

#
#   Loads a file into a package.
#
#   Courtesy Ben Tilly.
#
#   node_id=52229
#

sub load_lib {
  my $file = shift;
  my $pkg = shift;
  my $ret = eval "package $pkg; do '$file';";
  if (not defined($ret)) {
    $@ and confess("Cannot parse '$file': $@");
    $! and confess("Cannot load '$file': $!");    
    $@ and debugprint ("Cannot parse '$file': $@");
    $! and debugprint ("Cannot load '$file': $!");
    warn("Loading '$file' did not return a defined value");
  }
  $ret;
}


sub debugprint {
    if (DEBUG) {print scalar localtime , " : ", @_, "\n"};
}