liveframe-commits

[<ix...@us...>]

ixjonez     01/11/29 17:03:04

  Added:       .        .cvsignore Changes MANIFEST MANIFEST.SKIP
                        Makefile.PL README test.pl
               cgi-bin  .cvsignore lab.cgi.PL
               etc      lab.conf
               lib/Bundle/LiveFrame Lab.pm
               lib/LiveFrame Action.pm Application.pm Errors.pm Form.pm
                        Lab.pm
               lib/LiveFrame/Lab ConfirmAction.pm GalleryAction.pm
                        ImageAction.pm NotifyAction.pm ReviewAction.pm
                        StartAction.pm StartForm.pm
               share/docs TODO.txt configuration.txt templates.txt
               share/tmpl confirm.tmpl error.tmpl footer.tmpl gallery.tmpl
                        header.tmpl image.tmpl notify.tmpl review.tmpl
                        start.tmpl
               share/web lfstyles.css
               share/web/img 180.gif 270.gif 90.gif bottomarrow.gif
                        down.gif toparrow.gif up.gif
  Log:
  add initial files for LiveFrame Lab.
  
  Revision  Changes    Path
  1.1                  lab/.cvsignore
  
  Index: .cvsignore
  ===================================================================
  blib
  Makefile
  pm_to_blib
  *.tar.gz
  
  
  
  1.1                  lab/Changes
  
  Index: Changes
  ===================================================================
  Revision history for LiveFrame::Lab.
  
  0.01  Fri Nov 30 10:33:17 2001
  	- original version
  
  
  
  1.1                  lab/MANIFEST
  
  Index: MANIFEST
  ===================================================================
  Changes
  MANIFEST
  Makefile.PL
  README
  cgi-bin/lab.cgi.PL
  etc/lab.conf
  lib/Bundle/LiveFrame/Lab.pm
  lib/LiveFrame/Action.pm
  lib/LiveFrame/Application.pm
  lib/LiveFrame/Errors.pm
  lib/LiveFrame/Form.pm
  lib/LiveFrame/Lab.pm
  lib/LiveFrame/Lab/ConfirmAction.pm
  lib/LiveFrame/Lab/GalleryAction.pm
  lib/LiveFrame/Lab/ImageAction.pm
  lib/LiveFrame/Lab/NotifyAction.pm
  lib/LiveFrame/Lab/ReviewAction.pm
  lib/LiveFrame/Lab/StartAction.pm
  lib/LiveFrame/Lab/StartForm.pm
  share/docs/TODO.txt
  share/docs/actions.txt
  share/docs/configuration.txt
  share/docs/design.txt
  share/docs/object-model.txt
  share/docs/templates.txt
  share/tmpl/confirm.tmpl
  share/tmpl/error.tmpl
  share/tmpl/footer.tmpl
  share/tmpl/gallery.tmpl
  share/tmpl/header.tmpl
  share/tmpl/image.tmpl
  share/tmpl/notify.tmpl
  share/tmpl/review.tmpl
  share/tmpl/start.tmpl
  share/web/img/180.gif
  share/web/img/270.gif
  share/web/img/90.gif
  share/web/img/bottomarrow.gif
  share/web/img/down.gif
  share/web/img/toparrow.gif
  share/web/img/up.gif
  share/web/lfstyles.css
  test.pl
  
  
  
  1.1                  lab/MANIFEST.SKIP
  
  Index: MANIFEST.SKIP
  ===================================================================
  ~$
  ^MANIFEST\.
  ^Makefile$
  ^blib/
  ^pm_to_blib$
  \.old$
  \.bak$
  \.cvsignore$
  \.tar\.gz$
  CVS/
  ^cgi-bin/lab.cgi$
  ^bundle
  
  
  
  1.1                  lab/Makefile.PL
  
  Index: Makefile.PL
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  use ExtUtils::MakeMaker;
  
  WriteMakefile(
                NAME         => 'LiveFrame::Lab',
                VERSION_FROM => 'lib/LiveFrame/Lab.pm',
                PREREQ_PM    => {AppConfig => 0,
                                   CGI => 0,
                                   HTML::Entities => 0,
                                   Template => 2.0.6,
                                   URI => 0},
                PL_FILES     => {'cgi-bin/lab.cgi.PL' =>
                                 'cgi-bin/lab.cgi'},
                clean        => {FILES => 'cgi-bin/lab.cgi'},
                ($] >= 5.005 ?
                 (ABSTRACT_FROM => 'lib/LiveFrame/Lab.pm',
                  AUTHOR        => 'Brian Moseley <bc...@ma...>') : ()),
  );
  
  
  
  1.1                  lab/README
  
  Index: README
  ===================================================================
  LiveFrame Lab
  =============
  
  LiveFrame Lab is a Perl CGI application for creating photo galleries
  viewable with LiveFrame Gallery.
  
  The web site for LiveFrame Lab is located at
  <http://www.liveframe.org/lab/>.
  
  For comments, questions, bug reports etc, join the mailing list for
  LiveFrame Lab users by visiting
  <http://lists.sourceforge.net/lists/listinfo/liveframe-lab-users>.
  
  INSTALLATION
  
  (this is just a synopsis. more/better info soon -bcm)
  
  To install prerequisites, use the CPAN module to install the LiveFrame
  Lab bundle:
  
     perl -I`pwd/lib -MCPAN -e 'install Bundle::LiveFrame::Lab'
  
  To install LiveFrame Lab, type the following:
  
     perl Makefile.PL
     make
     make test
     make install
  
  DEPENDENCIES
  
  This module requires these other modules and libraries:
  
    AppConfig
    HTML::Entities (from the HTML-Parser distribution)
    Template (from the Template-Toolkit distribution)
    URI
  
  COPYRIGHT AND LICENCE
  
  Copyright (c) 2001 Brian Moseley <bc...@ma...>
  
  You may distribute under the terms of either the GNU General Public
  License or the Artistic License, as specified in the Perl README
  file.
  
  THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
  WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
  MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
  
  
  
  1.1                  lab/test.pl
  
  Index: test.pl
  ===================================================================
  # Before `make install' is performed this script should be runnable with
  # `make test'. After `make install' it should work as `perl test.pl'
  
  #########################
  
  use Test;
  BEGIN { plan tests => 1 };
  use LiveFrame::Lab;
  ok(1); # If we made it this far, we're ok.
  
  #########################
  
  # Insert your test code below, the Test module is use()ed here so read
  # its man page ( perldoc Test ) for help writing this test script.
  
  
  
  
  1.1                  lab/cgi-bin/.cvsignore
  
  Index: .cvsignore
  ===================================================================
  lab.cgi
  
  
  
  1.1                  lab/cgi-bin/lab.cgi.PL
  
  Index: lab.cgi.PL
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  # ripped off from LWP. Thanks!
  
  use strict;
  use Config;
  use File::Basename qw(basename dirname);
  
  chdir dirname $0;
  
  (my $file = basename $0) =~ s/\.PL$//;
  $file =~ s/\.pl$// if ($Config{'osname'} eq 'VMS' or
                         $Config{'osname'} eq 'OS2');  # "case-forgiving"
  
  open OUT,">$file" or die "Can't create $file: $!";
  chmod 0755, $file;
  
  print "Extracting $file (with variable substitutions)\n";
  
  print OUT <<"!GROK!THIS!";
  $Config{'startperl'} -wT
  
  !GROK!THIS!
  
  print OUT <<'!NO!SUBS!';
  use strict;
  use LiveFrame::Lab ();
  
  #
  # SITE-SPECIFIC CONFIGURATION
  #
  #
  # in the script, you only need to specify the location of the
  # configuration file. all other elements are configured inside that
  # file.
  
  my $config_file = '../etc/lab.conf';
  
  #
  # MAIN PROGRAM
  #
  
  LiveFrame::Lab->new->run({config_file => $config_file});
  !NO!SUBS!
  
  
  
  1.1                  lab/etc/lab.conf
  
  Index: lab.conf
  ===================================================================
  
  #
  # LiveFrame Lab configuration file
  #
  # The following tilde and variable expansions may be used in values:
  #
  #   ~        home directory of user owner of lab.cgi
  #   ~www     home directory of 'www' user
  #   $(var)   variable previously defined in the config file
  #   ${PWD}   environment variable 
  #
  # See docs/configuration.txt for more information on the available
  # configuration variables.
  #
  # the filesystem path to the page template directory
  # template_dir = ../share/tmpl
  #
  # the url to the images directory
  # img_url = ../img
  #
  # the url to the css directory
  # css_url = ..
  #
  # a list of filesystem paths to gallery site directories
  #
  site_dir = ~/work/code/liveframe/gallery-demo/lfdir/galleries
  site_dir = ~/work/code/maz/site/html/bcm/lfdir/galleries
  #
  # the filesystem path to the image upload directory
  upload_dir = ~/work/code/liveframe/uploads
  
  
  
  1.1                  lab/lib/Bundle/LiveFrame/Lab.pm
  
  Index: Lab.pm
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  package Bundle::LiveFrame::Lab;
  
  $VERSION = '0.01';
  
  1;
  __END__
  
  =pod
  
  =head1 NAME
  
  Bundle::LiveFrame::Lab - a bundle to install the dependencies for
  LiveFrame::Lab
  
  =head1 SYNOPSIS
  
  C<perl -MCPAN -e 'install Bundle::LiveFrame::Lab'>
  
  =head1 CONTENTS
  
  HTML::Entities
  
  URI
  
  AppConfig
  
  Template 2.0.6
  
  =head1 DESCRIPTION
  
  This bundle includes the dependencies for LiveFrame::Lab.
  
  =head1 AUTHOR
  
  Brian Moseley, bc...@ma...
  
  =cut
  
  
  
  1.1                  lab/lib/LiveFrame/Action.pm
  
  Index: Action.pm
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  package LiveFrame::Action;
  
  use strict;
  
  sub new {
      my ($type, $params) = @_;
      my $class = ref($type) || $type;
  
      my $self = bless
          {
           name => undef,
          }, $class;
  
      $self->init($params || {});
  
      return $self;
  }
  
  sub init {
      my ($self, $params) = @_;
  
      $self->name($params->{name}) if $params->{name};
  
      return 1;
  }
  
  sub name {
      my $self = shift;
      $self->{name} = shift if @_;
      return $self->{name};
  }
  
  1;
  
  
  
  1.1                  lab/lib/LiveFrame/Application.pm
  
  Index: Application.pm
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  package LiveFrame::Application;
  
  use strict;
  use AppConfig ();
  use CGI ();
  use Cwd ();
  use File::Spec ();
  use HTML::Entities ();
  use Template 2.0.6 ();
  use URI ();
  
  $LiveFrame::Application::VERSION = '0.01';
  
  sub new {
      my ($type) = @_;
      my $class = ref($type) || $type;
  
      my $self = bless {
                        actions              => {},
                        attrs                => {},
                        cgi                  => undef,
                        config               => undef,
                        config_processed     => undef,
                        config_file          => undef,
                        current_action_name  => undef,
                        current_control_name => undef,
                        current_form_name    => undef,
                        default_action_name  => undef,
                        default_error_page   => undef,
                        forms                => {},
                        template_dir         => undef,
                        tproc                => undef,
                       }, $class;
  
      return $self;
  }
  
  ## accessor methods
  
  sub action {
      my ($self, $name) = @_;
      return undef unless $name;
      return $self->{actions}->{$name};
  }
  
  sub actions {
      my ($self) = @_;
      my @actions = values %{ $self->{actions} };
      return wantarray ? @actions : \@actions;
  }
  
  sub add_action {
      my ($self, $name, $class) = @_;
      return undef unless $name && $class;
  
      eval "require $class";
      die "can't load action class $class: $@\n" if $@;
  
      my $action = $class->new();
      $action->name($name);
  
      $self->{actions}->{$name} = $action;
  
      return 1;
  }
  
  sub add_form {
      my ($self, $name, $class) = @_;
      return undef unless $name && $class;
  
      eval "require $class";
      die "can't load action class $class: $@\n" if $@;
  
      my $form = $class->new();
      $form->name($name);
  
      $self->{forms}->{$name} = $form;
  
      return 1;
  }
  
  sub attr {
      my $self = shift;
      my $name = shift or
          return undef;
      $self->{attrs}->{$name} = shift if @_;
      return $self->{attrs}->{$name};
  }
  
  sub attrs {
      my ($self) = @_;
      my @names = keys %{ $self->{attrs} };
      return wantarray ? @names : \@names;
  }
  
  sub cgi {
      my ($self) = @_;
      $self->{cgi} ||= CGI->new();
      return $self->{cgi};
  }
  
  sub config_vars {
      my ($self) = @_;
  
      $self->{config}->define("template_dir=s", { DEFAULT => './tmpl' });
      $self->{config}->define("img_url=s",      { DEFAULT => './img' });
      $self->{config}->define("css_url=s",      { DEFAULT => '.' });
  
      return 1;
  }
  
  sub config {
      my ($self) = @_;
  
      my $config_error = sub { die @_, "\n"; };
  
      unless ($self->{config}) {
          my $config_opts =
              {
               PEDANTIC => 1,
               ERROR => $config_error,
               GLOBAL => {EXPAND => AppConfig::EXPAND_ALL},
              };
  
          $self->{config} = AppConfig->new($config_opts);
  
          $self->config_vars();
      }
  
      return $self->{config};
  }
  
  sub config_file {
      my $self = shift;
      $self->{config_file} = shift if @_;
      return $self->{config_file};
  }
  
  sub control {
      my ($self) = @_;
      $self->form() unless defined $self->{control};
      return $self->{control};
  }
  
  sub css_url {
      my ($self) = @_;
      return $self->config()->css_url();
  }
  
  sub current_action {
      my ($self) = @_;
      my $name = $self->current_action_name();
      return defined $name ?
          $self->action($name) :
              $self->default_action();
  }
  
  sub current_action_name {
      my $self = shift;
  
      if (@_) {
          my $name = shift;
          unless ($self->action($name)) {
              die "current action $name is not defined\n";
          }
          $self->{current_action_name} = $name;
      } elsif (! defined $self->{current_action_name}) {
          my $path_info = $self->cgi()->path_info();
          if ($path_info) {
              $path_info =~ s|^/||;
              if ($path_info) {
                  ($self->{current_action_name} = $path_info) =~ s|/|_|g;
              }
          }
      }
  
      return $self->{current_action_name};
  }
  
  sub current_form {
      my ($self) = @_;
      my $form = $self->form($self->current_form_name()) or
          return undef;
  
      $form->control($self->current_control_name());
  
      my $cgi = $self->cgi();
      for my $name ($cgi->param()) {
          $form->$name($cgi->param($name)) if $form->can($name);
      }
  
      return $form;
  }
  
  sub current_control_name {
      my $self = shift;
      $self->{current_control_name} = shift if @_;
      return $self->{current_control_name};
  }
  
  sub current_form_name {
      my $self = shift;
  
      if (@_) {
          my $name = shift;
          unless ($self->form($name)) {
              die "current form $name is not defined\n";
          }
          $self->{current_form_name} = $name;
      } elsif (! defined $self->{current_form_name}) {
          for my $name ($self->cgi()->param()) {
              ($self->{current_form_name}, $self->{current_control_name}) =
                  ($name =~ m|^form_(.+)_(.+)$|);
              last if defined $self->{current_form_name};
          }
      }
  
      return $self->{current_form_name};
  }
  
  sub default_action {
      my ($self) = @_;
      return $self->action($self->default_action_name());
  }
  
  sub default_action_name {
      my $self = shift;
      $self->{default_action_name} = shift if @_;
      return $self->{default_action_name};
  }
  
  sub default_error_page {
      my $self = shift;
      $self->{default_error_page} = shift if @_;
      return $self->{default_error_page};
  }
  
  sub form {
      my ($self, $name) = @_;
      return undef unless $name;
      return $self->{forms}->{$name};
  }
  
  sub forms {
      my ($self) = @_;
      my @forms = values %{ $self->{forms} };
      return wantarray ? @forms : \@forms;
  }
  
  sub img_url {
      my ($self) = @_;
      return $self->config()->img_url();
  }
  
  sub remove_action {
      my ($self, $name) = @_;
      return undef unless $name;
      delete $self->{actions}->{name};
      return 1;
  }
  
  sub remove_form {
      my ($self, $name) = @_;
      return undef unless $name;
      delete $self->{forms}->{name};
      return 1;
  }
  
  sub template_dir {
      my ($self) = @_;
  
      unless (defined $self->{template_dir}) {
          my $orig = $self->config()->template_dir();
          $self->{template_dir} = File::Spec->file_name_is_absolute($orig) ?
              File::Spec->canonpath($orig) :
                  File::Spec->rel2abs($orig, Cwd::getcwd());
      }
  
      return $self->{template_dir};
  }
  
  sub tproc {
      my ($self) = @_;
  
      unless ($self->{tproc}) {
          my $tproc_opts =
              {
               INCLUDE_PATH => $self->template_dir(),
              };
  
          $self->{tproc} = Template->new($tproc_opts);
      }
  
      return $self->{tproc};
  }
  
  ## application utility methods
  
  sub fill_in_form {
      my ($self, $form) = @_;
  
      for my $name ($form->fields()) {
          $self->attr($name, $form->field($name));
      }
  
      return 1;
  }
  
  sub process_config {
      my ($self) = @_;
  
      unless ($self->{config_processed}) {
          $self->config()->file($self->config_file());
          $self->{config_processed} = 1;
      }
  
      return 1;
  }
  
  sub process_template {
      my ($self, $page, $tparams) = @_;
      $tparams ||= {};
  
      my $cgi = $self->cgi();
      my $config = $self->config();
      my $tproc = $self->tproc();
  
      for my $name ($self->attrs()) {
          $tparams->{$name} = $self->attr($name);
      }
  
      $tparams->{self_url} = $self->url($cgi->script_name());
      $tparams->{img_url}  = $self->url($config->img_url());
      $tparams->{css_url}  = $self->url($config->css_url());
  
      $tproc->process($self->template($page), $tparams) or do {
          $self->send_tmpl_error($tproc->error());
      };
  
      return 1;
  }
  
  sub send_page {
      my ($self, $page) = @_;
  
      print $self->cgi()->header();
  
      return $self->process_template($page);
  }
  
  sub send_redirect {
      my ($self, $page) = @_;
      my $cgi = $self->cgi();
  
      print $cgi->redirect(join('/', $cgi->script_name(), $page));
  
      return 1;
  }
  
  sub send_error {
      my ($self, $msg) = @_;
  
      print $self->cgi()->header();
  
      my $error_page = $self->default_error_page();
      if (defined $error_page) {
          return $self->process_template($error_page, {error_msg => $msg});
      }
  
      $msg = HTML::Entities::encode_entities($msg);
  
      print <<EOT;
  <p>
  <b>Application Error</b>
  </p>
  <pre>
  $msg
  </pre>
  EOT
  
      return 1;
  }
  
  sub send_tmpl_error {
      my ($self, $error) = @_;
  
      my $msg = $error->info() || '';
      $msg =~ s|\\n|\n|g;
      $msg = HTML::Entities::encode_entities($msg);
  
      print <<EOT;
  <p>
  <b>Template Error</b>
  </p>
  <pre>
  $msg
  </pre>
  EOT
  
      return 1;
  }
  
  sub template {
      my ($self, $page) = @_;
      return join('.', $page, 'tmpl');
  }
  
  sub url {
      my ($self, $path) = @_;
      my $cgi = $self->cgi();
  
      my $scheme = $cgi->https() ? 'https' : 'http';
      my $url = URI->new($path, $scheme);
  
      my $abs = $url->abs($cgi->script_name());
      $abs =~ s|/$||;
  
      return $abs;
  }
  
  ## run methods
  
  sub start {
      my ($self, $params) = @_;
      return 1 unless $params;
  
      $self->{config_file} = $params->{config_file};
      $self->{default_action_name} = 
          $params->{default_action_name} || 'default';
      $self->{default_error_page} = $params->{default_error_page};
  
      if ($params->{config_vars}) {
          unless (UNIVERSAL::isa($params->{config_vars}, 'ARRAY')) {
              die "application init param 'config_vars' must be an array ref\n";
          }
  
          my $config = $self->config();
          for my $var (@{ $params->{config_vars} }) {
              $config->define($var);
          }
      }
  
      if ($params->{actions}) {
          unless (UNIVERSAL::isa($params->{actions}, 'ARRAY')) {
              die "application init param 'actions' must be an array ref\n";
          }
  
          for (my $i = 0; $i < @{ $params->{actions} }; $i++) {
              my $action_params = $params->{actions}->[$i];
              unless (UNIVERSAL::isa($params, 'HASH')) {
                  die "application init param 'actions[$i]'",
                      " must be an array ref\n";
              }
              unless (defined $action_params->{name}) {
                  die "application init param 'actions[$i]", "->name'",
                      " must be defined\n";
              }
              unless (defined $action_params->{class}) {
                  die "application init param 'actions[$i]", "->class'",
                      " must be defined\n";
              }
  
              $self->add_action($action_params->{name},
                                $action_params->{class});
          }
      }
  
      if ($params->{forms}) {
          unless (UNIVERSAL::isa($params->{forms}, 'ARRAY')) {
              die "application init param 'forms' must be an array ref\n";
          }
  
          for (my $i = 0; $i < @{ $params->{forms} }; $i++) {
              my $form_params = $params->{forms}->[$i];
              unless (UNIVERSAL::isa($params, 'HASH')) {
                  die "application init param 'forms[$i]'",
                      " must be an array ref\n";
              }
              unless (defined $form_params->{name}) {
                  die "application init param 'forms[$i]", "->name'",
                      " must be defined\n";
              }
              unless (defined $form_params->{class}) {
                  die "application init param 'forms[$i]", "->class'",
                      " must be defined\n";
              }
  
              $self->add_form($form_params->{name},
                              $form_params->{class});
          }
      }
  
      return 1;
  }
  
  sub run {
      my ($self, $params) = @_;
  
      eval { $self->start($params) };
      if ($@) {
          $self->send_error("application could not be started: $@");
          return 0;
      }
  
      # force the config file to be read.
      eval { $self->process_config() };
      if ($@) {
          $self->send_error("config file error: $@");
          return 0;
      }
  
      my $action = eval { $self->current_action() };
      if ($@) {
          $self->send_error("can't get current action: $@");
          return 0;
      }
  
      if ($action) {
          my $form = eval { $self->current_form() };
          if ($@) {
              $self->send_error("can't get current form: $@");
              return 0;
          }
  
          if ($form) {
              # validate the form
              eval { $form->validate($self) };
              if ($@) {
                  # the form did not validate successfully. reset form
                  # variables and set errors. send the previous page again.
                  $self->attr('errors', $@);
                  $self->fill_in_form($form);
  
                  # XXX: requires the previous action to have the same name
                  # as the form in the page that it sends
                  $self->current_action_name($form->name());
                  $action = $self->current_action();
              }
          }
          else {
              # the action did not involve a form
              # XXX: how to signal that an action requires a form submission?
          }
  
          # execute the action method, which will send a page when it
          # completes
          eval { $action->perform($self) };
          if ($@) {
              $self->send_error($@);
          }
      }
      else {
          # no action exists for the specified action name so assume
          # it's a page name
          my $msg = sprintf("requested action [%s] not defined",
                            $self->current_action_name());
          $self->send_error($msg);
          return 0;
          # XXX: set a config switch to enable page sending?
  #        eval {
  #            $self->send_page($self->current_action_name());
  #        };
  #        if ($@) {
  #            $self->send_error($@);
  #        }
      }
  
      return 0;
  }
  
  1;
  
  
  
  
  
  1.1                  lab/lib/LiveFrame/Errors.pm
  
  Index: Errors.pm
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  package LiveFrame::Errors;
  
  use strict;
  
  sub new {
      my ($type, $params) = @_;
      my $class = ref($type) || $type;
  
      my $self = bless
          {
           errors => {},
          }, $class;
  
      $self->init($params || {});
  
      return $self;
  }
  
  sub init {
      my ($self, $params) = @_;
      return 1;
  }
  
  sub add_error {
      my ($self, $msg, $name) = @_;
      return undef unless defined $msg;
      $name ||= 'default';
      $self->{errors}->{$name} ||= [];
      push @{ $self->{errors}->{$name} }, $msg;
      return 1;
  }
  
  sub errors {
      my ($self, $name) = @_;
      $name ||= 'default';
      return undef unless exists $self->{errors}->{$name};
      my @errors = @{ $self->{errors}->{$name} };
      return wantarray ? @errors : \@errors;
  }
  
  sub error_types {
      my ($self) = @_;
      my @types = keys %{ $self->{types} };
      return wantarray ? @types : \@types;
  }
  
  sub remove_errors {
      my ($self, $name) = @_;
      return undef unless $name;
      delete $self->{errors}->{name};
      return 1;
  }
  
  1;
  
  
  
  1.1                  lab/lib/LiveFrame/Form.pm
  
  Index: Form.pm
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  package LiveFrame::Form;
  
  use strict;
  
  sub new {
      my ($type, $params) = @_;
      my $class = ref($type) || $type;
  
      my $self = bless
          {
           control => undef,
           name => undef,
           fields => {},
          }, $class;
  
      $self->init($params || {});
  
      return $self;
  }
  
  sub init {
      my ($self, $params) = @_;
  
      $self->name($params->{name}) if $params->{name};
      $self->control($params->{control}) if $params->{control};
  
      return 1;
  }
  
  ## accessors
  
  sub control {
      my $self = shift;
      $self->{control} = shift if @_;
      return $self->{control};
  }
  
  sub field {
      my $self = shift;
      my $name = shift or
          return undef;
      $self->{fields}->{$name} = shift if @_;
      return $self->{fields}->{$name};
  }
  
  sub fields {
      my $self = shift;
      my @names = keys %{ $self->{fields} };
      return wantarray ? @names : \@names;
  }
  
  sub name {
      my $self = shift;
      $self->{name} = shift if @_;
      return $self->{name};
  }
  
  ## public methods
  
  sub validate {
      my ($self, $lab) = @_;
  
      return 1;
  }
  
  1;
  
  
  
  1.1                  lab/lib/LiveFrame/Lab.pm
  
  Index: Lab.pm
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  package LiveFrame::Lab;
  
  use strict;
  use LiveFrame::Application ();
  
  $LiveFrame::Lab::VERSION = '0.01';
  @LiveFrame::Lab::ISA = ('LiveFrame::Application');
  
  sub start {
      my ($self, $params) = @_;
  
      $self->SUPER::start($params);
  
      $self->default_action_name('start');
      $self->default_error_page('error');
  
      my $config = $self->config();
      $config->define('site_dir=s@');
      $config->define('upload_dir=s');
  
      $self->add_action('start',   'LiveFrame::Lab::StartAction');
      $self->add_action('gallery', 'LiveFrame::Lab::GalleryAction');
      $self->add_action('image',   'LiveFrame::Lab::ImageAction');
      $self->add_action('review',  'LiveFrame::Lab::ReviewAction');
      $self->add_action('confirm', 'LiveFrame::Lab::ConfirmAction');
      $self->add_action('notify',  'LiveFrame::Lab::NotifyAction');
  
      $self->add_form('start',  'LiveFrame::Lab::StartForm');
  
      return 1;
  }
  
  
  
  1.1                  lab/lib/LiveFrame/Lab/ConfirmAction.pm
  
  Index: ConfirmAction.pm
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  package LiveFrame::Lab::ConfirmAction;
  
  use strict;
  use LiveFrame::Action ();
  
  @LiveFrame::Lab::ConfirmAction::ISA = ('LiveFrame::Action');
  
  sub perform {
      my ($self, $lab) = @_;
  
      return $lab->send_page('confirm');
  }
  
  1;
  
  
  
  1.1                  lab/lib/LiveFrame/Lab/GalleryAction.pm
  
  Index: GalleryAction.pm
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  package LiveFrame::Lab::GalleryAction;
  
  use strict;
  use LiveFrame::Action ();
  
  @LiveFrame::Lab::GalleryAction::ISA = ('LiveFrame::Action');
  
  sub perform {
      my ($self, $lab) = @_;
  
      $lab->attr('gallery_dir', $lab->cgi()->param('upload_set_dir'));
      return $lab->send_page('gallery');
  }
  
  1;
  
  
  
  1.1                  lab/lib/LiveFrame/Lab/ImageAction.pm
  
  Index: ImageAction.pm
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  package LiveFrame::Lab::ImageAction;
  
  use strict;
  use LiveFrame::Action ();
  
  @LiveFrame::Lab::ImageAction::ISA = ('LiveFrame::Action');
  
  sub perform {
      my ($self, $lab) = @_;
  
      return $lab->send_page('image');
  }
  
  1;
  
  
  
  1.1                  lab/lib/LiveFrame/Lab/NotifyAction.pm
  
  Index: NotifyAction.pm
  ===================================================================
  # -*- Mode: Perl; indent-tabs-mode: nil; -*-
  
  package LiveFrame::Lab::NotifyAction;
  
 ...
 
[truncated message content]