102 lines
2.5 KiB
Perl
102 lines
2.5 KiB
Perl
# ==================================================================
|
|
# 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__
|
|
|
|
|