First pass at adding key files
This commit is contained in:
dsainty
286
site/glist/lib/GT/CGI/Action/Common.pm
Normal file
286
site/glist/lib/GT/CGI/Action/Common.pm
Normal file
@ -0,0 +1,286 @@
|
||||
# ==================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::CGI::Action::Common
|
||||
# Author: Scott Beck
|
||||
# CVS Info :
|
||||
# $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__
|
||||
|
||||
|
||||
106
site/glist/lib/GT/CGI/Action/Plugin.pm
Normal file
106
site/glist/lib/GT/CGI/Action/Plugin.pm
Normal file
@ -0,0 +1,106 @@
|
||||
# ==================================================================
|
||||
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
||||
#
|
||||
# GT::CGI::Action::Plugin
|
||||
# Author: Scott Beck
|
||||
# CVS Info :
|
||||
# $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__
|
||||
|
||||
|
||||
Reference in New Issue
Block a user