# ================================================================== # Gossamer Threads Module Library - http://gossamer-threads.com/ # # GT::CGI::Action # Author: Scott Beck # CVS Info : # $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__