First pass at adding key files

2024-06-17 21:49:12 +10:00
commit aa25e9347f
1274 changed files with 392549 additions and 0 deletions
--- a/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/Action.pm
+++ b/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/Action.pm
@@ -0,0 +1,101 @@
+# ==================================================================
+# Gossamer Threads Module Library - http://gossamer-threads.com/
+#
+#   GT::CGI::Action
+#   Author: Scott Beck
+#   CVS Info : 087,071,086,086,085      
+#   $Id: Action.pm,v 1.8 2004/01/13 01:35:16 jagerman Exp $
+#
+# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
+# ==================================================================
+#
+# Description: 
+#       An API to make writting CGIs easier.
+#
+
+package GT::CGI::Action;
+# ==================================================================
+
+use vars qw/@ISA @EXPORT/;
+use strict;
+
+use GT::CGI::Action::Common;
+
+use Carp;
+
+@ISA = qw(GT::CGI::Action::Common);
+@EXPORT = qw(ACT_ERROR ACT_OK ACT_EXIT);
+
+sub can_page {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+
+    my $page = shift;
+    croak "No page specified" unless defined $page;
+
+    my $pages = $self->config->{pages};
+    return undef unless defined $pages and exists $pages->{$page};
+    return $pages->{$page}[PAGE_CAN];
+}
+
+sub can_action {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+
+    my $action = shift;
+    croak "No action specified" unless defined $action;
+
+    croak "Unknown arguments: @_" if @_;
+    my $actions = $self->config->{actions};
+    return undef unless defined $actions and exists $actions->{$action};
+
+    return 1;
+}
+
+sub run_action {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+
+    my $action = shift;
+    croak "No page specified" unless defined $action;
+
+    my $actions = $self->config->{actions};
+    croak "$action does not exist"
+        unless defined $actions and exists $actions->{$action};
+
+    my ($class, $func) = ($actions->{$action}[ACT_FUNCTION] =~ /(.+)::([^:]+)/);
+    eval "use $class();";
+    die "$@\n" if $@;
+    my $this = $class->new(%$self);
+    $this->action($action);
+    $this->$func(@_);
+    return $this;
+}
+
+# Shortcut function
+sub run_returns {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+
+    my $obj = shift;
+    croak "No object defined" unless defined $obj;
+
+    croak "Unknown arguments: @_" if @_;
+
+    if ($obj->return == ACT_ERROR) {
+        $self->print_page($obj->error_page);
+    }
+    elsif ($obj->return == ACT_OK) {
+        $self->print_page($obj->success_page);
+    }
+    elsif ($obj->return != ACT_EXIT) {
+        die "Unknown return from $obj";
+    }
+}
+
+
+1;
+
+__END__
+
+
--- a/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/Action/Common.pm
+++ b/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/Action/Common.pm
@@ -0,0 +1,286 @@
+# ==================================================================
+# Gossamer Threads Module Library - http://gossamer-threads.com/
+#
+#   GT::CGI::Action::Common
+#   Author: Scott Beck
+#   CVS Info : 087,071,086,086,085      
+#   $Id: Common.pm,v 1.14 2004/09/07 23:35:14 jagerman Exp $
+#
+# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
+# ==================================================================
+#
+# Description: 
+#       Provides a base class for GT::CGI::Action objects
+#
+
+package GT::CGI::Action::Common;
+# ==================================================================
+
+use vars qw/@EXPORT @ISA/;
+use strict;
+use constants
+
+    # Index in config action values
+    ACT_FUNCTION     => 0,
+    ACT_ERROR_PAGE   => 1,
+    ACT_SUCCESS_PAGE => 2,
+
+    # Index in config page values
+    PAGE_CAN         => 0,
+    PAGE_FUNCTION    => 1,
+
+    # Action returns
+    ACT_ERROR => 0,
+    ACT_OK    => 1,
+    ACT_EXIT  => 3;
+
+use Carp;
+use Exporter();
+
+@ISA = qw/Exporter/;
+@EXPORT = qw(
+    ACT_FUNCTION
+    ACT_ERROR_PAGE
+    ACT_SUCCESS_PAGE
+    PAGE_CAN
+    PAGE_FUNCTION
+    ACT_EXIT
+    ACT_OK
+    ACT_ERROR
+);
+
+sub new {
+# ----------------------------------------------------------------------------
+    my $class = shift;
+    croak "Areguments to new() must be a hash" if @_ & 1;
+    my %opts = @_;
+
+    my $guess_mime = exists($opts{guess_mime}) ? delete($opts{guess_mime}) : 1;
+
+    my $cgi = delete $opts{cgi};
+    unless (defined $cgi) {
+        require GT::CGI;
+        $cgi = new GT::CGI;
+    }
+
+    my $tpl = delete $opts{template};
+    unless (defined $tpl) {
+        require GT::Template;
+        $tpl = new GT::Template;
+    }
+
+    my $debug = delete $opts{debug};
+
+    my $tags = delete $opts{tags};
+    $tags = {} unless defined $tags;
+
+    my $config = delete $opts{config};
+    croak "No config specified"
+        unless defined $config;
+
+    my $action = delete $opts{action};
+    my $heap = delete $opts{heap};
+
+    croak "Unknown arguments: ", sort keys %opts if keys %opts;
+
+    my $self = bless {
+        cgi        => $cgi,
+        template   => $tpl,
+        tags       => $tags,
+        guess_mime => $guess_mime,
+        action     => $action,
+        debug      => $debug,
+        heap       => $heap
+    }, $class;
+    $self->config($config);
+    return $self;
+}
+
+sub config {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    if (@_) {
+        $self->{config} = shift;
+        unless (ref $self->{config}) {
+            require GT::Config;
+            $self->{config} = GT::Config->load($self->{config}, {
+                inheritance  => 1,
+                cache        => 1,
+                create_ok    => 0,
+                strict       => 0,
+                debug        => $self->{debug},
+                compile_subs => 0,
+            });
+        }
+        croak "Unknown arguments: @_" if @_;
+    }
+    return $self->{config};
+}
+
+sub tags {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    my %tags;
+    if (ref($_[0]) eq 'HASH') {
+        %tags = %{shift()};
+    }
+    else {
+        croak "Arguments to tags() must be a hash or hash ref" if @_ & 1;
+        %tags = @_;
+    }
+    @{$self->{tags}}{keys %tags} = (values %tags)
+        if keys %tags;
+    return $self->{tags};
+}
+
+sub cgi {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    if (@_) {
+        $self->{cgi} = shift;
+        croak "Unknown arguments: @_" if @_;
+    }
+    return $self->{cgi};
+}
+
+sub heap {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    if (@_) {
+        $self->{heap} = shift;
+        croak "Unknown arguments: @_" if @_;
+    }
+    return $self->{heap};
+}
+
+sub action {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    if (@_) {
+        $self->{action} = shift;
+        croak "Unknown arguments: @_" if @_;
+    }
+    return $self->{action};
+}
+
+sub guess_mime {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    if (@_) {
+        $self->{guess_mime} = shift;
+        croak "Unknown arguments: @_" if @_;
+    }
+    return $self->{guess_mime};
+}
+
+sub debug {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    if (@_) {
+        $self->{debug} = shift;
+        croak "Unknown arguments: @_" if @_;
+    }
+    return $self->{debug};
+}
+
+sub template {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    if (@_) {
+        $self->{template} = shift;
+        croak "Unknown arguments: @_" if @_;
+    }
+    return $self->{template};
+}
+
+# Shortcut to $self->tags(message => "message");
+sub info {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    my $message = shift;
+    croak "Unknown arguments: @_" if @_;
+    $self->tags(message => $message);
+}
+
+# Shortcut to $self->tags(message => "message"); $self->print_page("page");
+sub print_info {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    my $page = shift;
+    croak "No page specified" unless defined $page;
+    $self->info(@_);
+    $self->print_page($page);
+}
+
+# Shortcut to $self->tags(error => "message");
+sub error {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    my $error = shift;
+    croak "Unknown arguments: @_" if @_;
+    $self->tags(error => $error);
+}
+
+# Shortcut to $self->tags(error => "message"); $self->print_page("page");
+sub print_error {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    my $page = shift;
+    croak "No page specified" unless defined $page;
+    $self->info(@_);
+    $self->print_page($page);
+}
+
+# Shortcut to print $self->cgi->cookie(..)->cookie_header, "\r\n";
+sub print_cookie {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    print $self->cgi->cookie(@_)->cookie_header, "\r\n";
+}
+
+sub print_page {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    my $page = shift;
+    croak "No page specified to print" unless defined $page;
+    $self->tags(page => $page);
+
+    if (defined $self->{config}{pages}{$page}[PAGE_FUNCTION]) {
+        my ($class, $func) = ($self->{config}{pages}{$page}[PAGE_FUNCTION] =~ /(.+)::([^:]+)/);
+        eval "use $class();";
+        die "$@\n" if $@;
+        my $this = $class->new(%$self);
+        $this->$func(@_);
+    }
+
+    if ($self->guess_mime) {
+        require GT::MIMETypes;
+        my $type = GT::MIMETypes->guess_type($page);
+        print $self->cgi->header($type);
+        if ($type =~ /text/) {
+            return $self->template->parse_print($page, $self->tags);
+        }
+        else {
+            local *FH;
+            open FH, "<$page"
+                or die "Could not open $page; Reason: $!";
+            my $buff;
+            binmode STDOUT;
+            while (read(FH, $buff, 4096)) {
+                print STDOUT $buff;
+            }
+            close FH;
+            return 1;
+        }
+    }
+    else {
+        print $self->cgi->header;
+    }
+    $self->template->parse_print($page, $self->tags);
+}
+
+1;
+
+__END__
+
+
--- a/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/Action/Plugin.pm
+++ b/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/Action/Plugin.pm
@@ -0,0 +1,106 @@
+# ==================================================================
+# Gossamer Threads Module Library - http://gossamer-threads.com/
+#
+#   GT::CGI::Action::Plugin
+#   Author: Scott Beck
+#   CVS Info : 087,071,086,086,085      
+#   $Id: Plugin.pm,v 1.5 2004/01/13 01:35:16 jagerman Exp $
+#
+# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
+# ==================================================================
+#
+# Description: 
+#
+
+package GT::CGI::Action::Plugin;
+# ==================================================================
+
+use vars qw/@ISA @EXPORT/;
+use strict;
+
+use GT::CGI::Action::Common;
+
+use Carp;
+
+@ISA = qw(GT::CGI::Action::Common);
+@EXPORT = qw(ACT_ERROR ACT_OK ACT_EXIT);
+
+sub return {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    if (@_) {
+        $self->{return} = shift;
+        croak "Unknown arguments: @_" if @_;
+    }
+    return $self->{return};
+}
+
+sub info {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    $self->SUPER::info(@_) if @_;
+    $self->return(ACT_OK);
+}
+
+sub print_info {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    $self->SUPER::print_info(@_);
+    $self->return(ACT_EXIT);
+}
+
+sub error {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    $self->SUPER::error(@_) if @_;
+    $self->return(ACT_ERROR);
+}
+
+sub print_error {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    $self->SUPER::print_error(@_);
+    $self->return(ACT_ERROR);
+}
+
+sub exit {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    $self->return(ACT_EXIT);
+}
+
+sub error_page {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    if (@_) {
+        $self->{error_page} = shift;
+        croak "Unknown arguments: @_" if @_;
+    }
+    if (defined $self->{error_page}) {
+        return $self->{error_page};
+    }
+    croak "No action was ever specified" unless defined $self->action;
+    return $self->{config}{actions}{$self->action}[ACT_ERROR_PAGE];
+    
+}
+
+sub success_page {
+# ----------------------------------------------------------------------------
+    my $self = shift;
+    if (@_) {
+        $self->{success_page} = shift;
+        croak "Unknown arguments: @_" if @_;
+    }
+    if (defined $self->{success_page}) {
+        return $self->{success_page};
+    }
+    croak "No action was ever specified" unless defined $self->action;
+    return $self->{config}{actions}{$self->action}[ACT_SUCCESS_PAGE];
+}
+
+
+1;
+
+__END__
+
+
--- a/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/Cookie.pm
+++ b/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/Cookie.pm
@@ -0,0 +1,103 @@
+# ==================================================================
+# Gossamer Threads Module Library - http://gossamer-threads.com/
+#
+#   GT::CGI::Cookie
+#   CVS Info : 087,071,086,086,085      
+#   $Id: Cookie.pm,v 1.7 2008/06/09 23:39:47 brewt Exp $
+# 
+# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
+# ==================================================================
+#
+# Description:
+#   Handles cookie creation and formatting
+#
+
+package GT::CGI::Cookie;
+#================================================================================
+
+use strict;
+use GT::CGI;
+use GT::Base;
+use vars qw/@ISA $ATTRIBS @MON @WDAY/;
+
+@ISA = qw/GT::Base/;
+
+$ATTRIBS = {
+    -name     => '',
+    -value    => '',
+    -expires  => '',
+    -path     => '',
+    -domain   => '',
+    -secure   => '',
+    -httponly => '',
+};
+@MON  = qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
+@WDAY = qw/Sun Mon Tue Wed Thu Fri Sat/;
+
+sub cookie_header {
+#--------------------------------------------------------------------------------
+# Returns a cookie header.
+#
+    my $self    = shift;
+
+# make sure we have a name to use
+    $self->{-name} or return;
+
+    my $name  = GT::CGI::escape($self->{-name});
+    my $value = GT::CGI::escape($self->{-value});
+
+# build the header that creates the cookie
+    my $header = "Set-Cookie: $name=$value";
+
+    $self->{-expires} and $header .= "; expires=" . $self->format_date('-', $self->{-expires});
+    if (my $path = $self->{-path}) { $path =~ s/[\x00-\x1f].*//s; $header .= "; path=$path"; }
+    if (my $domain = $self->{-domain}) { $domain =~ s/[\x00-\x1f].*//s; $header .= "; domain=$domain"; }
+    $self->{-secure}  and $header .= "; secure";
+    $self->{-httponly} and $header .= "; httponly";
+
+    return $header;
+}
+
+sub format_date {
+# -------------------------------------------------------------------
+# Returns a string in http_gmt format, but accepts one in unknown format.
+#   Wed, 23 Aug 2000 21:20:14 GMT
+#
+    my ($self, $sep, $datestr) = @_;
+    my $unix_time = defined $datestr ? $self->expire_calc($datestr) : time;
+
+    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($unix_time);
+    $year += 1900;
+
+    return sprintf(
+        "%s, %02d$sep%s$sep%04d %02d:%02d:%02d GMT",
+        $WDAY[$wday], $mday, $MON[$mon], $year, $hour, $min, $sec
+    );
+}
+*_format_date = \&format_date; # deprecated
+
+sub expire_calc {
+# -------------------------------------------------------------------
+# Calculates when a date based on +- times. See CGI.pm for more info.
+#
+    my ($self, $time) = @_;
+    my %mult = (s => 1, m => 60, h => 3600, d => 86400, M => 2592000, y => 31536000);
+    my $offset;
+
+    if (!$time or lc $time eq 'now') {
+        $offset = 0;
+    }
+    elsif ($time =~ /^\d/) {
+        return $time;
+    }
+    elsif ($time=~/^([+-]?(?:\d+(?:\.\d*)?|\.\d+))([smhdMy]?)/) {
+        $offset = $1 * ($mult{$2} || 1);
+    }
+    else {
+        return $time;
+    }
+    return time + $offset;
+}
+*_expire_calc = \&expire_calc; # deprecated
+
+1;
--- a/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/EventLoop.pm
+++ b/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/EventLoop.pm
@@ -0,0 +1,502 @@
+# ==================================================================
+# Gossamer Threads Module Library - http://gossamer-threads.com/
+#
+#   GT::CGI::EventLoop
+#   Author  : Scott Beck
+#   CVS Info : 087,071,086,086,085      
+#   $Id: EventLoop.pm,v 1.5 2004/09/07 23:35:14 jagerman Exp $
+#
+# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
+# ==================================================================
+#
+# Description: Impliments an EventLoop API for CGI programming
+#
+
+package GT::CGI::EventLoop;
+# ==================================================================
+
+use vars qw/$ATTRIBS $ERRORS @EXPORT_OK %EXPORT_TAGS/;
+use strict;
+use bases 'GT::Base' => ''; # GT::Base inherits from Exporter
+use constants
+    STOP  => 1,
+    EXIT  => 2,
+    CONT  => 3,
+    HEAP  => 0,
+    EVENT => 1,
+    IN    => 2,
+    CGI   => 3,
+    ARG0  => 4,
+    ARG1  => 5,
+    ARG2  => 6,
+    ARG3  => 7,
+    ARG4  => 8,
+    ARG5  => 9,
+    ARG6  => 10,
+    ARG7  => 11,
+    ARG8  => 12,
+    ARG9  => 13;
+
+use GT::CGI;
+use GT::MIMETypes;
+
+$ERRORS = {
+    NOACTION => 'No action was passed from CGI input and no default action was set',
+    NOFUNC   => 'No function in %s'
+};
+
+$ATTRIBS = {
+    do                        => 'do',
+    format_page_tags          => undef,
+    default_do                => undef,
+    init_events               => undef,
+    init_events_name          => undef,
+    default_page              => 'home',
+    default_group             => undef,
+    default_page_pre_event    => undef,
+    default_page_post_event   => undef,
+    default_group_pre_event   => undef,
+    default_group_post_event  => undef,
+    needs_array_input         => undef,
+    plugin_object             => undef,
+    template_path             => undef,
+    pre_package               => '',
+    cgi                       => undef,
+    in                        => {},
+    heap                      => {},
+    page_events               => {},
+    page_pre_events           => {},
+    page_post_events          => {},
+    group_pre_events          => {},
+    group_post_events         => {},
+    groups                    => {},
+    group                     => undef,
+    page                      => undef,
+    print_page                => \&GT::CGI::EventLoop::print_page,
+    status                    => CONT,
+    cookies                   => []
+};
+
+@EXPORT_OK = qw/
+    STOP EXIT CONT
+    HEAP EVENT IN CGI
+    ARG0 ARG1 ARG2 ARG3 ARG4 ARG5 ARG6 ARG7 ARG8 ARG9
+/;
+
+%EXPORT_TAGS = (
+    all     => [@EXPORT_OK],
+    status  => [qw/STOP EXIT CONT/],
+    args    => [qw/
+        HEAP EVENT IN CGI
+        ARG0 ARG1 ARG2 ARG3 ARG4 ARG5 ARG6 ARG7 ARG8 ARG9
+    /]
+);
+
+sub init {
+# --------------------------------------------------------------------
+    my $self = shift;
+    $self->set( @_ ) if @_;
+    $self->{cgi} ||= new GT::CGI;
+    for ( $self->{cgi}->param ) {
+        my @val = $self->{cgi}->param($_);
+        my $val;
+        my $match;
+        for my $field ( @{$self->{needs_array_input}} ) {
+            if ( $_ eq $field ) {
+                $match = 1;
+                last;
+            }
+        }
+        if ( !$match ) {
+            $val = $val[0];
+        }
+        else {
+            $val = \@val;
+        }
+        $self->{in}{$_} = $val;
+    }
+}
+
+sub mainloop {
+# --------------------------------------------------------------------
+    my $self = shift;
+    $self->init( @_ ) if @_;
+
+    if ( !defined $self->{in}{$self->{do}} ) {
+        if ( defined $self->{default_do} ) {
+            $self->{in}{$self->{do}} = $self->{default_do};
+        }
+        else {
+            $self->fatal( 'NOACTION' );
+        }
+    }
+    if ( $self->{init_events} ) {
+        local $self->{in}{$self->{do}} = $self->{init_events_name} if $self->{init_events_name};
+            
+        $self->dispatch( $self->{init_events} );
+        return if $self->{status} == EXIT;
+    }
+    $self->_call_group;
+    $self->_call_page;    
+}
+
+sub do_param {
+# --------------------------------------------------------------------
+    my $self = shift;
+    if ( @_ ) {
+        $self->add_hidden( $self->{do} => $_[0] );
+    }
+    return $self->{in}{$self->{do}};
+}
+
+sub stop { $_[0]->{status} = STOP }
+sub exit { $_[0]->{status} = EXIT }
+sub cont { $_[0]->{status} = CONT }
+
+sub _call_group {
+# --------------------------------------------------------------------
+    my ( $self ) = @_;
+    $self->{group} ||= $self->{in}{$self->{do}} || $self->{default_do};
+    my $orig_group = $self->{group};
+    # FIXME Add infinite recursion checks!
+    for ( keys %{$self->{groups}} ) {
+        if ( index( $self->{group}, $_ ) == 0 ) {
+            if ( exists $self->{group_pre_events}{$_} ) {
+                $self->dispatch( $self->{group_pre_events}{$_} );
+                return if $self->{status} == EXIT;
+            
+                if ( $self->{group} ne $orig_group ) {
+                    return $self->_call_group;
+                }
+            }
+            elsif ( defined $self->{default_group_pre_event} ) {
+                $self->dispatch( $self->{default_group_pre_event} );
+                return if $self->{status} == EXIT;
+                if ( $self->{group} ne $orig_group ) {
+                    return $self->_call_group;
+                }
+            }
+            $self->dispatch( $self->{groups}{$_} );
+            if ( $self->{group} ne $orig_group ) {
+                return $self->_call_group;
+            }
+            if ( exists $self->{group_post_events}{$_} ) {
+                $self->dispatch( $self->{group_post_events}{$_} );
+                return if $self->{status} == EXIT;
+                if ( $self->{group} ne $orig_group ) {
+                    return $self->_call_group;
+                }
+            }
+            elsif ( defined $self->{default_group_post_event} ) {
+                $self->dispatch( $self->{default_group_post_event} );
+                return if $self->{status} == EXIT;
+                if ( $self->{group} ne $orig_group ) {
+                    return $self->_call_group;
+                }
+            }
+            return;
+        }
+    }
+
+# Default group
+    $self->dispatch( $self->{default_group} ) if $self->{default_group};
+    if ( $self->{default_group} and $self->{group} ne $orig_group ) {
+        return $self->_call_group;
+    }
+}
+
+sub _call_page {
+# --------------------------------------------------------------------
+    my ( $self ) = @_;
+    if ( !$self->{page} ) {
+        $self->page( $self->{default_page} );
+    }
+    my $orig_page = $self->{page};
+    if ( exists $self->{page_pre_events}{$self->{page}} ) {
+        $self->dispatch( $self->{page_pre_events}{$self->{page}} );
+        return if $self->{status} == EXIT;
+        if ( $self->{page} ne $orig_page ) {
+            return $self->_call_page;
+        }
+    }
+    elsif ( defined $self->{default_page_pre_event} ) {
+        $self->dispatch( $self->{default_page_pre_event} );
+        return if $self->{status} == EXIT;
+        if ( $self->{page} ne $orig_page ) {
+            return $self->_call_page;
+        }
+    }
+    $self->{print_page}->( $self );
+
+# Run post page events, can't change the page on a post event
+    if ( exists $self->{page_post_events}{$self->{page}} ) {
+        $self->dispatch( $self->{page_post_events}{$self->{page}} );
+    }
+    elsif ( defined $self->{default_page_post_event} ) {
+        $self->dispatch( $self->{default_page_post_event} );
+    }
+}
+
+sub cookie_jar {
+# --------------------------------------------------------------------
+# $obj->cookie_jar($cookie_object);
+# ---------------------------------
+#   Stores cookies for printing when print_page is called.
+#   $cookie_object should be a GT::CGI::Cookie object. Passing undef
+#   will empty the cookies array ref.
+#
+    my $self = shift;
+    if ( !defined( $_[0] ) and @_ > 0 ) {
+        $self->{cookies} = [];
+    }
+    elsif ( @_ > 0 ) {
+        push( @{$self->{cookies}}, $_[0] );
+    }
+    return $self->{cookies};
+}
+
+sub add_hidden {
+# --------------------------------------------------------------------
+    my $self = shift;
+    if ( @_ and !defined( $_[0] ) ) {
+        $self->{hidden} = {};
+    }
+    elsif ( @_ ) {
+        $self->{hidden}{$_[0]} = $_[1];
+    }
+}
+
+sub remove_hidden {
+# --------------------------------------------------------------------
+    my $self = shift;
+    return delete $self->{hidden}{$_[0]};
+}
+
+sub get_url_hidden {
+# --------------------------------------------------------------------
+    my ( $self ) = @_;
+    my $ret = '';
+    for ( keys %{$self->{hidden}} ) {
+        next unless defined $self->{hidden}{$_};
+        $ret .= $self->{cgi}->escape( $_ ).'='.$self->{cgi}->escape( $self->{hidden}{$_} ).';';
+    }
+    return $ret;
+}
+
+sub get_form_hidden {
+# --------------------------------------------------------------------
+    my ( $self ) = @_;
+    my $ret = '';
+    for ( keys %{$self->{hidden}} ) {
+        next unless defined $self->{hidden}{$_};
+        $ret .= '<input type="hidden" name="'.$self->{cgi}->html_escape( $_ ).'" value="'.$self->{cgi}->html_escape( $self->{hidden}{$_} ).'">';
+    }
+    return $ret;
+}
+
+sub page {
+# --------------------------------------------------------------------
+    my $self = shift;
+    if ( @_ > 0 ) {
+        $self->{page} = $self->guess_page( $_[0] );
+        $self->debug( "Set page to $self->{page}" ) if $self->{_debug};
+        $self->yield( $self->{page_events} ) if $self->{page_events};
+    }
+    return $self->{page};
+}
+
+sub guess_page {
+# --------------------------------------------------------------------
+    my ( $self, $page ) = @_;
+    if ( -e "$self->{template_path}/$page.htm" ) {
+        $page = "$page.htm";
+    }
+    elsif ( -e "$self->{template_path}/$page.html" ) {
+        $page = "$page.html";
+    }
+    return $page;
+}
+
+sub tags {
+# --------------------------------------------------------------------
+    my $self = shift;
+    my ( %tags ) = ref( $_[0] ) eq 'HASH' ? %{$_[0]} : @_;
+    for ( keys %tags ) {
+        $self->{tags}{$_} = $tags{$_};
+    }
+    return $self->{tags};
+}
+
+sub default_tags {
+# --------------------------------------------------------------------
+    my ( $self, %tags ) = @_;
+
+    my $set;
+    for ( keys %tags ) {
+        $set->{$_} = ( defined( $self->{in}{$_} ) and length( $self->{in}{$_} ) ? $self->{in}{$_} : $tags{$_} );
+    }
+    $self->tags( %$set );
+}
+
+sub print_page {
+# --------------------------------------------------------------------
+    my ( $self ) = @_;
+    my $form_hidden = $self->get_form_hidden;
+    my $url_hidden  = $self->get_url_hidden;
+    my $tags        = $self->tags( url_hidden => \$url_hidden, form_hidden => \$form_hidden );
+    $tags = $self->yield( $self->{format_page_tags}, $tags ) if defined $self->{format_page_tags};
+    my $page        = $self->page || 'index.htm';
+
+# Cookies can be set with CGI input
+    my $cookies = [];
+    if ( $self->{in}{'set-cookie'} ) {
+        foreach my $key ( keys %{$self->{in}} ) {
+            if ( $key =~ /^cookie-(.*)/ ) {
+                push @$cookies, $self->{cgi}->cookie( -name => $1, -value => $self->{in}{$key}, -path => '/' );
+            }
+        }
+    }
+
+# See if we have any cookies in out cookie jar (used through program operation to set cookies without printing
+# a header)
+    if ( @{$self->cookie_jar} ) {
+        push @$cookies, @{$self->cookie_jar};
+    }
+
+# If we have cookie header to print print them
+    print @{$cookies}
+        ? $self->{cgi}->header(
+            -cookie => $cookies,
+            -type   => GT::MIMETypes->guess_type( $page )
+        )
+        : $self->{cgi}->header( GT::MIMETypes->guess_type( $page ) );
+
+    my $base = $self->{template_path};
+
+# Make sure the template exists and is readable
+    -e "$base/$page" or die "No page ($base/$page)";
+    -r _ or die "Page isn't readable by this process ($< $>) ($base/$page)";
+
+    require GT::Template;
+    GT::Template->parse( $page, $tags, {
+        root      => $base,
+        escape    => 1,
+        print     => 1,
+        heap      => [ $self->func_args ]
+    } );
+
+}
+
+sub page_pre_events {
+# --------------------------------------------------------------------
+    my ( $self, %in ) = @_;
+    if ( keys %in ) {
+        $self->{page_pre_events} = {};
+        for ( keys %in ) {
+            my $val = ref( $in{$_} ) eq 'ARRAY' ? $in{$_} : [ $in{$_} ];
+            $self->{page_pre_events}{$self->guess_page( $_ )} = $val;
+        }
+    }
+    return $self->{page_pre_events};
+}
+
+sub page_post_events {
+# --------------------------------------------------------------------
+    my ( $self, %in ) = @_;
+    if ( keys %in ) {
+        $self->{page_post_events} = {};
+        for ( keys %in ) {
+            my $val = ref( $in{$_} ) eq 'ARRAY' ? $in{$_} : [ $in{$_} ];
+            $self->{page_post_events}{$self->guess_page( $_ )} = $val;
+        }
+    }
+    return $self->{page_post_events};
+}
+
+sub group_pre_events {
+# --------------------------------------------------------------------
+    my ( $self, %in ) = @_;
+    if ( keys %in ) {
+        $self->{group_pre_events} = {};
+        for ( keys %in ) {
+            my $val = ref( $in{$_} ) eq 'ARRAY' ? $in{$_} : [ $in{$_} ];
+            $self->{group_pre_events}{$_} = $val;
+        }
+    }
+    return $self->{group_pre_events};
+}
+
+sub group_post_events {
+# --------------------------------------------------------------------
+    my ( $self, %in ) = @_;
+    if ( keys %in ) {
+        $self->{group_post_events} = {};
+        for ( keys %in ) {
+            my $val = ref( $in{$_} ) eq 'ARRAY' ? $in{$_} : [ $in{$_} ];
+            $self->{group_post_events}{$_} = $val;
+        }
+    }
+    return $self->{group_post_events};
+}
+
+sub dispatch {
+# --------------------------------------------------------------------
+    my ( $self, $pfunc, @args ) = @_;
+    $pfunc = ref( $pfunc ) eq 'ARRAY' ? $pfunc : [ $pfunc ];
+    for ( @$pfunc ) {
+        $self->yield( $_, @args );
+        return if $self->{status} == EXIT or $self->{status} == STOP;
+    }
+}
+
+sub yield {
+# --------------------------------------------------------------------
+    my ( $self, $pfunc, @args ) = @_;
+    if ( !ref( $pfunc ) ) {
+        $self->debug( "Yielding $pfunc" ) if $self->{_debug} > 1;
+        my ( $pkg, $func );
+        if ( index( $pfunc, '::' ) != -1 ) {
+            ($pkg, $func) = $pfunc =~ /^(.*)::(.*)$/;
+        }
+        else {
+            $func = $pfunc;
+        }
+        defined( $func ) or $self->fatal( 'NOFUNC', $pfunc );
+        $pkg = $self->{pre_package}.$pkg if $self->{pre_package} and $pkg;
+        $pkg ||= $self->{pre_package} if $self->{pre_package};
+        $pkg ||= 'main';
+        $pkg =~ s/::$//;
+        no strict 'refs';
+        unless ( defined %{$pkg . '::'} ) {
+            eval "require $pkg";
+            die "Could not compile $pkg; Reason: $@" if $@;
+        }
+        if ( defined $self->{plugin_object} ) {
+            $self->debug( "dispatching --> $pkg\::$func" ) if $self->{_debug};
+            return $self->{plugin_object}->dispatch( $pkg.'::'.$func, \&{$pkg.'::'.$func}, $self->func_args(@args) );
+        }
+        else {
+            no strict 'refs';
+            $self->debug( "Calling $pkg\::$func" ) if $self->{_debug};
+            return &{$pkg.'::'.$func}( $self->func_args(@args) );
+        }
+        $self->yield( $_, @args );
+    }
+    elsif ( ref( $pfunc ) eq 'CODE' ) {
+        $self->debug( "In yeild with code ref.") if $self->{_debug};
+        if ( defined $self->{plugin_object} ) {
+            $self->debug( "dispatching --> $self->{in}{$self->{do}}" ) if $self->{_debug};
+            return $self->{plugin_object}->dispatch( $self->{in}{$self->{do}}, $pfunc, $self->func_args(@args) );
+        }
+        else {
+            $self->debug( "Calling code ref" ) if $self->{_debug};
+            return $pfunc->( $self->func_args(@args) );
+        }
+    }
+}
+
+sub func_args { $_[0]->{heap}, $_[0], $_[0]->{in}, $_[0]->{cgi}, @_[1 .. $#_] }
+
+1;
+
+
--- a/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/Fh.pm
+++ b/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/Fh.pm
@@ -0,0 +1,70 @@
+# ==================================================================
+# Gossamer Threads Module Library - http://gossamer-threads.com/
+#
+#   GT::CGI::Fh
+#   CVS Info : 087,071,086,086,085      
+#   $Id: Fh.pm,v 1.2 2004/01/13 01:35:16 jagerman Exp $
+# 
+# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
+# ==================================================================
+#
+# Description:
+#   Magic filehandle that prints the name, but is still a filehandle for reads -
+#   just like CGI.pm.
+#
+package GT::CGI::Fh;
+# ===================================================================
+use strict 'vars', 'subs';
+use vars qw/$FH/;
+use Fcntl qw/O_RDWR O_EXCL/;
+use overload
+    '""'  => \&as_string,
+    'cmp' => \&compare,
+    'fallback' => 1;
+
+sub new {
+# -------------------------------------------------------------------
+# Create a new filehandle based on a counter, and the filename.
+#
+    my ($pkg, $name, $file, $delete) = @_;
+    my $fname = sprintf("FH%05d%s", ++$FH, $name);
+
+    $fname =~ s/([:'%])/sprintf '%%%02X', ord $1/eg;
+    my $fh = \do { local *{$fname}; *{$fname} };
+
+    sysopen($fh, $file, O_RDWR | O_EXCL, 0600) or die "Can't open file: $file ($!)";
+    unlink($file) if $delete;
+    bless $fh, $pkg;
+
+    return $fh;
+}
+
+sub as_string {
+# -------------------------------------------------------------------
+# Return the filename, strip off leading junk first.
+#
+    my $self = shift;
+    my $fn   = $$self;
+    $fn =~ s/%(..)/ chr(hex($1)) /eg;
+    $fn =~ s/^\*GT::CGI::Fh::FH\d{5}//;
+    return $fn;
+}
+
+sub compare {
+# -------------------------------------------------------------------
+# Do comparisions, uses as_string to get file name first.
+#
+    my $self  = shift;
+    my $value = shift;
+    return "$self" cmp $value;
+}
+
+DESTROY {
+# -------------------------------------------------------------------
+# Close file handle.
+#
+    my $self = shift;
+    close $self;
+}
+
+1;
--- a/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/MultiPart.pm
+++ b/site/slowtwitch.com/cgi-bin/articles/admin/GT/CGI/MultiPart.pm
@@ -0,0 +1,270 @@
+# ==================================================================
+# Gossamer Threads Module Library - http://gossamer-threads.com/
+#
+#   GT::CGI::MultiPart
+#   CVS Info : 087,071,086,086,085      
+#   $Id: MultiPart.pm,v 1.12 2008/07/14 23:40:31 brewt Exp $
+# 
+# Copyright (c) 2004 Gossamer Threads Inc.  All Rights Reserved.
+# ==================================================================
+#
+# Description:
+#   Multipart form handling for GT::CGI objects.
+#
+# This is taken almost entirely from CGI.pm, and is loaded on demand.
+#
+
+package GT::CGI::MultiPart;
+# ==============================================================================
+use strict 'vars', 'subs';
+use GT::CGI;
+use GT::Base;
+use GT::TempFile();
+use vars qw/$DEBUG $ERRORS @ISA $ATTRIBS $CRLF/;
+
+@ISA = qw/GT::Base/;
+use constants
+    BLOCK_SIZE => 4096,
+    MAX_READS  => 2000;
+$CRLF = "\015\012";
+$ATTRIBS = {
+    fh       => undef,      # web request on stdin
+    buffer   => '',         # buffer to hold tmp data
+    length   => 0,          # length of file to parse
+    boundary => undef,      # mime boundary to look for
+    fillunit => BLOCK_SIZE, # amount to read per chunk
+    safety   => 0           # safety counter
+};
+$ERRORS = {
+    NOBOUNDARY   => "Unable to find a MIME boundary in environment. Content-type looks like: %s",
+    CLIENTABORT  => "Unable to read data from server. Still have %s bytes to read, but got 0. Data in buffer is: %s",
+    BADMULTIPART => "Invalid multipart message. Nothing left to read, and can't find closing boundary. Data in buffer is: %s"
+};
+
+sub parse {
+# -------------------------------------------------------------------
+# Parses a multipart form to handle file uploads.
+#
+    my ($class, $cgi, $callback) = @_;
+
+# We override any fatal handlers as our handlers typically create a CGI object
+# avoiding a nasty loop.
+    local $SIG{__DIE__} = 'DEFAULT';
+
+# We only load the multipart parser if we have multipart code.
+    my $parser = $class->new or return;
+
+    my ($header, $name, $value, $filename);
+    until ($parser->eof) {
+        $header = $parser->read_header or return die "BADREQUEST";
+        if ($header->{'Content-Disposition'} =~ m/ name=(?:"([^"]*)"|((?!")[^;]*))/) {
+            $name = length $1 ? $1 : $2;
+        }
+
+        $filename = '';
+        if ($header->{'Content-Disposition'} =~ m/ filename=(?:"([^"]*)"|((?!")[^;]*))/) {
+            $filename = length $1 ? $1 : $2;
+
+# Strip off any paths from the filename (IE sends the full path to the file).
+            $filename =~ s|^.*[/\\]|| if $filename;
+        }
+
+        $name .= $GT::CGI::TAINTED;
+        $filename .= $GT::CGI::TAINTED;
+
+# Not a file, just regular form data.
+        if (! defined $filename or $filename eq '') {
+            $value = $parser->read_body;
+
+# Netscape 6 does some fun things with line feeds in multipart form data
+            $value =~ s/\r\r/\r/g; # What it does on unix
+            $value =~ s/\r\n/\n/g if $^O eq 'MSWin32';
+            unless ($cgi->{params}->{$name}) {
+                push @{$cgi->{param_order}}, $name;
+            }
+            unshift @{$cgi->{params}->{$name}}, $value;
+            next;
+        }
+
+# Print out the data to a temp file.
+        local $\;
+        my $tmp_file = new GT::TempFile;
+        require GT::CGI::Fh;
+        my $fh = GT::CGI::Fh->new($filename, $$tmp_file, 0);
+        binmode $fh;
+        my $data;
+        my $bytes_read = 0;
+        while (defined($data = $parser->read)) {
+            if (defined $callback and (ref $callback eq 'CODE')) {
+                $bytes_read += length $data;
+                $callback->($filename, \$data, $bytes_read);
+            }
+            print $fh $data;
+        }
+        seek $fh, 0, 0;
+        unless ($cgi->{params}->{$name}) {
+            push @{$cgi->{param_order}}, $name;
+        }
+        unshift @{$cgi->{params}->{$name}}, $fh;
+    }
+}
+
+sub init {
+# -------------------------------------------------------------------
+# Initilize our object.
+#
+    $DEBUG = $GT::CGI::DEBUG;
+
+    my $self = shift;
+
+# Get the boundary marker.
+    my $boundary;
+    if (defined $ENV{CONTENT_TYPE} and $ENV{CONTENT_TYPE} =~ /boundary=\"?([^\";,]+)\"?/) {
+        $boundary = $1 . $GT::CGI::TAINTED;
+    }
+    else {
+        return $self->error("NOBOUNDARY", "FATAL", $ENV{CONTENT_TYPE});
+    }
+    $self->{boundary} = "--$boundary";
+
+# Get our filehandle.
+    binmode(STDIN);
+
+# And if the boundary is > the BLOCK_SIZE, adjust.
+    if (length $boundary > $self->{fillunit}) {
+        $self->{fillunit} = length $boundary;
+    }
+
+# Set the content-length.
+    $self->{length} = $ENV{CONTENT_LENGTH} || 0;
+
+# Read the preamble and the topmost (boundary) line plus the CRLF.
+    while ($self->read) { }
+}
+
+sub fill_buffer {
+# -------------------------------------------------------------------
+# Fill buffer.
+#
+    my ($self, $bytes) = @_;
+
+    return unless $self->{length};
+
+    my $boundary_length = length $self->{boundary};
+    my $buffer_length   = length $self->{buffer};
+    my $bytes_to_read   = $bytes - $buffer_length + $boundary_length + 2;
+    $bytes_to_read      = $self->{length} if $self->{length} < $bytes_to_read;
+
+    my $bytes_read = read(STDIN, $self->{buffer}, $bytes_to_read, $buffer_length);
+    if (! defined $self->{buffer}) {
+        $self->{buffer} = '';
+    }
+    if ($bytes_read == 0) {
+        if ($self->{safety}++ > MAX_READS) {
+            return $self->error(CLIENTABORT => FATAL => $self->{length}, $self->{buffer});
+        }
+    }
+    else {
+        $self->{safety} = 0;
+    }
+
+    $self->{length} -= $bytes_read;
+}
+
+sub read {
+# -------------------------------------------------------------------
+# Read some input.
+#
+    my $self  = shift;
+    my $bytes = $self->{fillunit};
+
+# Load up self->{buffer} with data.
+    $self->fill_buffer($bytes);
+
+# find the boundary (if exists).
+    my $start = index($self->{buffer}, $self->{boundary});
+
+# Make sure the post was formed properly.
+    unless (($start >= 0) or ($self->{length} > 0)) {
+        return $self->error(BADMULTIPART => FATAL => $self->{buffer});
+    }
+
+    if ($start == 0) {
+# Quit if we found the last boundary at the beginning.
+        if (index($self->{buffer},"$self->{boundary}--") == 0) {
+            $self->{buffer} = '';
+            $self->{length} = 0;
+            return;
+        }
+# Otherwise remove the boundary (+2 to remove line feeds).
+        substr($self->{buffer}, 0, length ($self->{boundary}) + 2) = '';
+        return;
+    }
+    
+    my $bytes_to_return;
+    if ($start > 0) {
+        $bytes_to_return = $start > $bytes ? $bytes : $start;
+    }
+    else {
+        $bytes_to_return = $bytes - length($self->{boundary}) + 1;
+    }
+
+    my $return = substr($self->{buffer}, 0, $bytes_to_return);
+    substr($self->{buffer}, 0, $bytes_to_return) = '';
+
+    return $start > 0 ? substr($return, 0, -2) : $return;
+}
+
+sub read_header {
+# -------------------------------------------------------------------
+# Reads the header.
+#
+    my $self = shift;
+    my ($ok, $bad, $end, $safety) = (0, 0);
+    until ($ok or $bad) {
+        $self->fill_buffer($self->{fillunit});
+
+        $ok++ if ($end = index($self->{buffer}, "$CRLF$CRLF")) >= 0;
+        $ok++ if $self->{buffer} eq '';
+        $bad++ if !$ok and $self->{length} <= 0;
+        return if $safety++ >= 10;
+    }
+    
+    return if $bad;
+
+    my $header = substr($self->{buffer}, 0, $end + 2);
+    substr($self->{buffer}, 0, $end + 4) = '';
+
+    my %header;
+    my $token = '[-\w!\#$%&\'*+.^_\`|{}~]';
+    $header   =~ s/$CRLF\s+/ /og;
+    while ($header =~ /($token+):\s+([^$CRLF]*)/go) {
+        my ($field_name, $field_value) = ($1 . $GT::CGI::TAINTED, $2 . $GT::CGI::TAINTED);
+        $field_name =~ s/\b(\w)/\u$1/g; 
+        $header{$field_name} = $field_value;
+    }
+    return \%header;
+}
+
+sub read_body {
+# -------------------------------------------------------------------
+# Reads a body and returns as a single scalar value.
+#
+    my $self   = shift;
+    my $data   = '';
+    my $return = '';
+    while (defined($data = $self->read)) {
+        $return .= $data;
+    }
+    return $return;
+}
+
+sub eof {
+# -------------------------------------------------------------------
+# Return true when we've finished reading.
+#
+    my $self = shift;
+    return 1 if length $self->{buffer} == 0 and $self->{length} <= 0;
+}
+
+1;