|
From: <ix...@us...> - 2001-12-19 05:36:13
|
ixjonez 01/12/18 21:36:13
Added: lib/LiveFrame Action.pm Application.pm Errors.pm Form.pm
Log:
move application classes to commons
Revision Changes Path
1.1 commons/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 commons/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,
committed => 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 => '../share/tmpl' });
$self->{config}->define("img_url=s", { DEFAULT => '../lab/img' });
$self->{config}->define("css_url=s", { DEFAULT => '../lab' });
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;
my $orig = shift if @_;
if (defined $orig || ! defined $self->{config_file}) {
$orig ||= $self->config()->config_file();
my $file = File::Spec->file_name_is_absolute($orig) ?
File::Spec->canonpath($orig) :
File::Spec->rel2abs($orig, Cwd::getcwd());
-f $file or
die "config file $file not found\n";
$self->{config_file} = $file;
}
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 (@_) {
$self->{current_action_name} = shift;
} 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(),
PLUGIN_BASE => 'LiveFrame::Template::Plugin',
};
$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->{application} = $self;
$tparams->{config} = $self->config();
$tparams->{cgi} = $self->cgi();
$tparams->{page} = $page;
my $current_form_name = $self->current_form_name() || '';
if ($current_form_name eq $page) {
my $form = $self->current_form();
if ($form) {
$tparams->{form} = $form;
}
}
$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(), $page);
};
return 1;
}
sub send_header {
my ($self) = @_;
print $self->cgi()->header() unless $self->{committed};
$self->{committed} = 1;
return 1;
}
sub send_page {
my ($self, $page) = @_;
$self->send_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, $tmpl) = @_;
$self->send_header();
my $error_page = $self->default_error_page();
if (defined $error_page) {
my $tparams = { error_msg => $msg };
if (defined $tmpl) {
$tparams->{error_type} = 'template';
$tparams->{error_tmpl} = $tmpl;
}
else {
$tparams->{error_type} = 'application';
}
return $self->process_template($error_page, $tparams);
}
$msg = HTML::Entities::encode_entities($msg);
print <<EOT;
<p>
<b>Application Error</b>
</p>
<p>
An internal application error was encountered:
</p>
<pre>
$msg
</pre>
EOT
return 1;
}
sub send_tmpl_error {
my ($self, $error, $page) = @_;
my $msg = $error->info() || '';
$msg =~ s|\\n|\n|g;
my $tmpl = $self->template($page);
eval { $self->send_error($msg, $tmpl) };
if ($@) {
$msg = HTML::Entities::encode_entities($msg);
print <<EOT;
<p>
<b>Template Error</b>
</p>
<p>
An error was encountered processing <i>$tmpl</i>:
</p>
<pre>
$msg
</pre>
<p>
Additionally, an error was encountered processing the default error page:
</p>
<pre>
$@
</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 htat 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?
}
# if the action wasn't unset (usually by an invalid form
# submission), execute the action method, which will send a
# page when it completes
if ($action) {
eval { $action->perform($self, $form) };
if ($@) {
$self->send_error($@);
}
}
}
unless ($action) {
# no action exists for the specified action name so assume
# it's a page name
# XXX: set a config switch to disable page sending?
# my $msg = sprintf("requested action [%s] not defined",
# $self->current_action_name());
# $self->send_error($msg);
# return 0;
eval {
$self->send_page($self->current_action_name() ||
$self->default_action_name());
};
if ($@) {
$self->send_error($@);
}
}
return 0;
}
1;
1.1 commons/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 commons/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;
|