commit perl-CGI-Application

Hello community, here is the log from the commit of package perl-CGI-Application checked in at Tue Nov 4 17:51:27 CET 2008. -------- --- perl-CGI-Application/perl-CGI-Application.changes 2008-09-12 13:50:12.000000000 +0200 +++ /mounts/work_src_done/STABLE/perl-CGI-Application/perl-CGI-Application.changes 2008-11-04 11:55:00.000000000 +0100 @@ -1,0 +2,28 @@ +Tue Nov 4 11:53:11 CET 2008 - cwh@suse.de + +- 4.20 Sat Nov 1, 2008 + + [DOCUMENTATION] + - typo fix (Lyle) + +- 4.19_1 Fri Sep 27, 2008 + + [FEATURES] + - New 'html_tmpl_class' method allows you to specify an alternative + HTML::Template class. This technique will eliminate the need to use + a plugin for HTML::Template-compatible classes. See the docs + for load_tmpl() for details. + + Thanks to Rhesa Rozendaal for the initial patch, and Mark Stosberg for + documentation refinements. + + [DOCUMENTATION] + - typo fix (George Hartzell) + - Revert back to documenting the use of "$self", not $c, after community + feedback. + + [INTERNALS] + - Change how default run modes are declared for better compatibility + with AutoRunmode and RunmodeDeclare plugins. Thanks Rhesa via RT#39631. + +------------------------------------------------------------------- calling whatdependson for head-i586 Old: ---- CGI-Application-4.11.tar.bz2 New: ---- CGI-Application-4.20.tar.bz2 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-CGI-Application.spec ++++++ --- /var/tmp/diff_new_pack.Z29319/_old 2008-11-04 17:51:00.000000000 +0100 +++ /var/tmp/diff_new_pack.Z29319/_new 2008-11-04 17:51:00.000000000 +0100 @@ -1,5 +1,5 @@ # -# spec file for package perl-CGI-Application (Version 4.11) +# spec file for package perl-CGI-Application (Version 4.20) # # Copyright (c) 2008 SUSE LINUX Products GmbH, Nuernberg, Germany. # @@ -19,7 +19,7 @@ Name: perl-CGI-Application -Version: 4.11 +Version: 4.20 Release: 1 Provides: CGI-Application Requires: perl = %{perl_version} @@ -74,6 +74,25 @@ /var/adm/perl-modules/%{name} %changelog +* Tue Nov 04 2008 cwh@suse.de +- 4.20 Sat Nov 1, 2008 + [DOCUMENTATION] + - typo fix (Lyle) +- 4.19_1 Fri Sep 27, 2008 + [FEATURES] + - New 'html_tmpl_class' method allows you to specify an alternative + HTML::Template class. This technique will eliminate the need to use + a plugin for HTML::Template-compatible classes. See the docs + for load_tmpl() for details. + Thanks to Rhesa Rozendaal for the initial patch, and Mark Stosberg for + documentation refinements. + [DOCUMENTATION] + - typo fix (George Hartzell) + - Revert back to documenting the use of "$self", not $c, after community + feedback. + [INTERNALS] + - Change how default run modes are declared for better compatibility + with AutoRunmode and RunmodeDeclare plugins. Thanks Rhesa via RT#39631. * Fri Sep 12 2008 cwh@suse.de - 4.11 Sun Aug 10, 2008 No code changes. ++++++ CGI-Application-4.11.tar.bz2 -> CGI-Application-4.20.tar.bz2 ++++++ diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/CGI-Application-4.11/Changes new/CGI-Application-4.20/Changes --- old/CGI-Application-4.11/Changes 2008-08-10 17:34:30.000000000 +0200 +++ new/CGI-Application-4.20/Changes 2008-11-02 01:41:27.000000000 +0100 @@ -1,5 +1,30 @@ Revision history for CGI::Application. +4.20 Sat Nov 1, 2008 + + [DOCUMENTATION] + - typo fix (Lyle) + +4.19_1 Fri Sep 27, 2008 + + [FEATURES] + - New 'html_tmpl_class' method allows you to specify an alternative + HTML::Template class. This technique will eliminate the need to use + a plugin for HTML::Template-compatible classes. See the docs + for load_tmpl() for details. + + Thanks to Rhesa Rozendaal for the initial patch, and Mark Stosberg for + documentation refinements. + + [DOCUMENTATION] + - typo fix (George Hartzell) + - Revert back to documenting the use of "$self", not $c, after community + feedback. + + [INTERNALS] + - Change how default run modes are declared for better compatibility + with AutoRunmode and RunmodeDeclare plugins. Thanks Rhesa via RT#39631. + 4.11 Sun Aug 10, 2008 No code changes. diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/CGI-Application-4.11/lib/CGI/Application.pm new/CGI-Application-4.20/lib/CGI/Application.pm --- old/CGI-Application-4.11/lib/CGI/Application.pm 2008-08-10 17:34:30.000000000 +0200 +++ new/CGI-Application-4.20/lib/CGI/Application.pm 2008-11-02 01:38:26.000000000 +0100 @@ -3,7 +3,7 @@ use strict; use Class::ISA; -$CGI::Application::VERSION = '4.11'; +$CGI::Application::VERSION = '4.20'; my %INSTALLED_CALLBACKS = ( # hook name package sub @@ -29,34 +29,34 @@ } # Create our object! - my $c = {}; - bless($c, $class); + my $self = {}; + bless($self, $class); ### SET UP DEFAULT VALUES ### # # We set them up here and not in the setup() because a subclass # which implements setup() still needs default values! - $c->header_type('header'); - $c->mode_param('rm'); - $c->start_mode('start'); + $self->header_type('header'); + $self->mode_param('rm'); + $self->start_mode('start'); # Process optional new() parameters my $rprops; if (ref($args[0]) eq 'HASH') { - $rprops = $c->_cap_hash($args[0]); + $rprops = $self->_cap_hash($args[0]); } else { - $rprops = $c->_cap_hash({ @args }); + $rprops = $self->_cap_hash({ @args }); } # Set tmpl_path() if (exists($rprops->{TMPL_PATH})) { - $c->tmpl_path($rprops->{TMPL_PATH}); + $self->tmpl_path($rprops->{TMPL_PATH}); } # Set CGI query object if (exists($rprops->{QUERY})) { - $c->query($rprops->{QUERY}); + $self->query($rprops->{QUERY}); } # Set up init param() values @@ -64,33 +64,33 @@ croak("PARAMS is not a hash ref") unless (ref($rprops->{PARAMS}) eq 'HASH'); my $rparams = $rprops->{PARAMS}; while (my ($k, $v) = each(%$rparams)) { - $c->param($k, $v); + $self->param($k, $v); } } # Lock prerun_mode from being changed until cgiapp_prerun() - $c->{__PRERUN_MODE_LOCKED} = 1; + $self->{__PRERUN_MODE_LOCKED} = 1; # Call cgiapp_init() method, which may be implemented in the sub-class. # Pass all constructor args forward. This will allow flexible usage # down the line. - $c->call_hook('init', @args); + $self->call_hook('init', @args); # Call setup() method, which should be implemented in the sub-class! - $c->setup(); + $self->setup(); - return $c; + return $self; } sub __get_runmode { - my $c = shift; + my $self = shift; my $rm_param = shift; my $rm; # Support call-back instead of CGI mode param if (ref($rm_param) eq 'CODE') { # Get run mode from subref - $rm = $rm_param->($c); + $rm = $rm_param->($self); } # support setting run mode from PATH_INFO elsif (ref($rm_param) eq 'HASH') { @@ -98,24 +98,24 @@ } # Get run mode from CGI param else { - $rm = $c->query->param($rm_param); + $rm = $self->query->param($rm_param); } # If $rm undefined, use default (start) mode - $rm = $c->start_mode unless defined($rm) && length($rm); + $rm = $self->start_mode unless defined($rm) && length($rm); return $rm; } sub __get_runmeth { - my $c = shift; + my $self = shift; my $rm = shift; my $rmeth; my $is_autoload = 0; - my %rmodes = ($c->run_modes()); + my %rmodes = ($self->run_modes()); if (exists($rmodes{$rm})) { $rmeth = $rmodes{$rm}; } @@ -132,20 +132,20 @@ } sub __get_body { - my $c = shift; + my $self = shift; my $rm = shift; - my ($rmeth, $is_autoload) = $c->__get_runmeth($rm); + my ($rmeth, $is_autoload) = $self->__get_runmeth($rm); my $body; eval { - $body = $is_autoload ? $c->$rmeth($rm) : $c->$rmeth(); + $body = $is_autoload ? $self->$rmeth($rm) : $self->$rmeth(); }; if ($@) { my $error = $@; - $c->call_hook('error', $error); - if (my $em = $c->error_mode) { - $body = $c->$em( $error ); + $self->call_hook('error', $error); + if (my $em = $self->error_mode) { + $body = $self->$em( $error ); } else { croak("Error executing run mode '$rm': $error"); } @@ -158,45 +158,45 @@ sub run { - my $c = shift; - my $q = $c->query(); + my $self = shift; + my $q = $self->query(); - my $rm_param = $c->mode_param(); + my $rm_param = $self->mode_param(); - my $rm = $c->__get_runmode($rm_param); + my $rm = $self->__get_runmode($rm_param); # Set get_current_runmode() for access by user later - $c->{__CURRENT_RUNMODE} = $rm; + $self->{__CURRENT_RUNMODE} = $rm; # Allow prerun_mode to be changed - delete($c->{__PRERUN_MODE_LOCKED}); + delete($self->{__PRERUN_MODE_LOCKED}); # Call PRE-RUN hook, now that we know the run mode # This hook can be used to provide run mode specific behaviors # before the run mode actually runs. - $c->call_hook('prerun', $rm); + $self->call_hook('prerun', $rm); # Lock prerun_mode from being changed after cgiapp_prerun() - $c->{__PRERUN_MODE_LOCKED} = 1; + $self->{__PRERUN_MODE_LOCKED} = 1; # If prerun_mode has been set, use it! - my $prerun_mode = $c->prerun_mode(); + my $prerun_mode = $self->prerun_mode(); if (length($prerun_mode)) { $rm = $prerun_mode; - $c->{__CURRENT_RUNMODE} = $rm; + $self->{__CURRENT_RUNMODE} = $rm; } # Process run mode! - my $body = $c->__get_body($rm); + my $body = $self->__get_body($rm); # Support scalar-ref for body return $body = $$body if ref $body eq 'SCALAR'; # Call cgiapp_postrun() hook - $c->call_hook('postrun', \$body); + $self->call_hook('postrun', \$body); # Set up HTTP headers - my $headers = $c->_send_headers(); + my $headers = $self->_send_headers(); # Build up total output my $output = $headers.$body; @@ -207,7 +207,7 @@ } # clean up operations - $c->call_hook('teardown'); + $self->call_hook('teardown'); return $output; } @@ -218,7 +218,7 @@ ############################ sub cgiapp_get_query { - my $c = shift; + my $self = shift; # Include CGI.pm and related modules require CGI; @@ -231,7 +231,7 @@ sub cgiapp_init { - my $c = shift; + my $self = shift; my @args = (@_); # Nothing to init, yet! @@ -239,7 +239,7 @@ sub cgiapp_prerun { - my $c = shift; + my $self = shift; my $rm = shift; # Nothing to prerun, yet! @@ -247,7 +247,7 @@ sub cgiapp_postrun { - my $c = shift; + my $self = shift; my $bodyref = shift; # Nothing to postrun, yet! @@ -255,16 +255,12 @@ sub setup { - my $c = shift; - - $c->run_modes( - 'start' => 'dump_html', - ); + my $self = shift; } sub teardown { - my $c = shift; + my $self = shift; # Nothing to shut down, yet! } @@ -277,19 +273,19 @@ ###################################### sub dump { - my $c = shift; + my $self = shift; my $output = ''; # Dump run mode - my $current_runmode = $c->get_current_runmode(); + my $current_runmode = $self->get_current_runmode(); $current_runmode = "" unless (defined($current_runmode)); $output .= "Current Run mode: '$current_runmode'\n"; # Dump Params $output .= "\nQuery Parameters:\n"; - my @params = $c->query->param(); + my @params = $self->query->param(); foreach my $p (sort(@params)) { - my @data = $c->query->param($p); + my @data = $self->query->param($p); my $data_str = "'".join("', '", @data)."'"; $output .= "\t$p => $data_str\n"; } @@ -305,12 +301,12 @@ sub dump_html { - my $c = shift; - my $query = $c->query(); + my $self = shift; + my $query = $self->query(); my $output = ''; # Dump run-mode - my $current_runmode = $c->get_current_runmode(); + my $current_runmode = $self->get_current_runmode(); $output .= "<p>Current Run-mode: '<strong>$current_runmode</strong>'</p>\n"; @@ -334,31 +330,31 @@ sub header_add { - my $c = shift; - return $c->_header_props_update(\@_,add=>1); + my $self = shift; + return $self->_header_props_update(\@_,add=>1); } sub header_props { - my $c = shift; - return $c->_header_props_update(\@_,add=>0); + my $self = shift; + return $self->_header_props_update(\@_,add=>0); } # used by header_props and header_add to update the headers sub _header_props_update { - my $c = shift; + my $self = shift; my $data_ref = shift; my %in = @_; my @data = @$data_ref; # First use? Create new __HEADER_PROPS! - $c->{__HEADER_PROPS} = {} unless (exists($c->{__HEADER_PROPS})); + $self->{__HEADER_PROPS} = {} unless (exists($self->{__HEADER_PROPS})); my $props; # If data is provided, set it! if (scalar(@data)) { - if ($c->header_type eq 'none') { + if ($self->header_type eq 'none') { warn "header_props called while header_type set to 'none', headers will NOT be sent!" } # Is it a hash, or hash-ref? @@ -376,55 +372,55 @@ # merge in new headers, appending new values passed as array refs if ($in{add}) { for my $key_set_to_aref (grep { ref $props->{$_} eq 'ARRAY'} keys %$props) { - my $existing_val = $c->{__HEADER_PROPS}->{$key_set_to_aref}; + my $existing_val = $self->{__HEADER_PROPS}->{$key_set_to_aref}; next unless defined $existing_val; my @existing_val_array = (ref $existing_val eq 'ARRAY') ? @$existing_val : ($existing_val); $props->{$key_set_to_aref} = [ @existing_val_array, @{ $props->{$key_set_to_aref} } ]; } - $c->{__HEADER_PROPS} = { %{ $c->{__HEADER_PROPS} }, %$props }; + $self->{__HEADER_PROPS} = { %{ $self->{__HEADER_PROPS} }, %$props }; } # Set new headers, clobbering existing values else { - $c->{__HEADER_PROPS} = $props; + $self->{__HEADER_PROPS} = $props; } } # If we've gotten this far, return the value! - return (%{ $c->{__HEADER_PROPS}}); + return (%{ $self->{__HEADER_PROPS}}); } sub header_type { - my $c = shift; + my $self = shift; my ($header_type) = @_; my @allowed_header_types = qw(header redirect none); # First use? Create new __HEADER_TYPE! - $c->{__HEADER_TYPE} = 'header' unless (exists($c->{__HEADER_TYPE})); + $self->{__HEADER_TYPE} = 'header' unless (exists($self->{__HEADER_TYPE})); # If data is provided, set it! if (defined($header_type)) { $header_type = lc($header_type); croak("Invalid header_type '$header_type'") unless(grep { $_ eq $header_type } @allowed_header_types); - $c->{__HEADER_TYPE} = $header_type; + $self->{__HEADER_TYPE} = $header_type; } # If we've gotten this far, return the value! - return $c->{__HEADER_TYPE}; + return $self->{__HEADER_TYPE}; } sub param { - my $c = shift; + my $self = shift; my (@data) = (@_); # First use? Create new __PARAMS! - $c->{__PARAMS} = {} unless (exists($c->{__PARAMS})); + $self->{__PARAMS} = {} unless (exists($self->{__PARAMS})); - my $rp = $c->{__PARAMS}; + my $rp = $self->{__PARAMS}; # If data is provided, set it! if (scalar(@data)) { @@ -453,47 +449,47 @@ sub delete { - my $c = shift; + my $self = shift; my ($param) = @_; # return undef it the param name isn't given return undef unless defined $param; - #simply delete this param from $c->{__PARAMS} - delete $c->{__PARAMS}->{$param}; + #simply delete this param from $self->{__PARAMS} + delete $self->{__PARAMS}->{$param}; } sub query { - my $c = shift; + my $self = shift; my ($query) = @_; # We're only allowed to set a new query object if one does not yet exist! - unless (exists($c->{__QUERY_OBJ})) { + unless (exists($self->{__QUERY_OBJ})) { my $new_query_obj; # If data is provided, set it! Otherwise, create a new one. if (defined($query)) { $new_query_obj = $query; } else { - $new_query_obj = $c->cgiapp_get_query(); + $new_query_obj = $self->cgiapp_get_query(); } - $c->{__QUERY_OBJ} = $new_query_obj; + $self->{__QUERY_OBJ} = $new_query_obj; } - return $c->{__QUERY_OBJ}; + return $self->{__QUERY_OBJ}; } sub run_modes { - my $c = shift; + my $self = shift; my (@data) = (@_); # First use? Create new __RUN_MODES! - $c->{__RUN_MODES} = {} unless (exists($c->{__RUN_MODES})); + $self->{__RUN_MODES} = { 'start' => 'dump_html' } unless (exists($self->{__RUN_MODES})); - my $rr_m = $c->{__RUN_MODES}; + my $rr_m = $self->{__RUN_MODES}; # If data is provided, set it! if (scalar(@data)) { @@ -520,83 +516,83 @@ sub start_mode { - my $c = shift; + my $self = shift; my ($start_mode) = @_; # First use? Create new __START_MODE - $c->{__START_MODE} = 'start' unless (exists($c->{__START_MODE})); + $self->{__START_MODE} = 'start' unless (exists($self->{__START_MODE})); # If data is provided, set it if (defined($start_mode)) { - $c->{__START_MODE} = $start_mode; + $self->{__START_MODE} = $start_mode; } - return $c->{__START_MODE}; + return $self->{__START_MODE}; } sub error_mode { - my $c = shift; + my $self = shift; my ($error_mode) = @_; # First use? Create new __ERROR_MODE - $c->{__ERROR_MODE} = undef unless (exists($c->{__ERROR_MODE})); + $self->{__ERROR_MODE} = undef unless (exists($self->{__ERROR_MODE})); # If data is provided, set it. if (defined($error_mode)) { - $c->{__ERROR_MODE} = $error_mode; + $self->{__ERROR_MODE} = $error_mode; } - return $c->{__ERROR_MODE}; + return $self->{__ERROR_MODE}; } sub tmpl_path { - my $c = shift; + my $self = shift; my ($tmpl_path) = @_; # First use? Create new __TMPL_PATH! - $c->{__TMPL_PATH} = '' unless (exists($c->{__TMPL_PATH})); + $self->{__TMPL_PATH} = '' unless (exists($self->{__TMPL_PATH})); # If data is provided, set it! if (defined($tmpl_path)) { - $c->{__TMPL_PATH} = $tmpl_path; + $self->{__TMPL_PATH} = $tmpl_path; } # If we've gotten this far, return the value! - return $c->{__TMPL_PATH}; + return $self->{__TMPL_PATH}; } sub prerun_mode { - my $c = shift; + my $self = shift; my ($prerun_mode) = @_; # First use? Create new __PRERUN_MODE - $c->{__PRERUN_MODE} = '' unless (exists($c->{__PRERUN_MODE})); + $self->{__PRERUN_MODE} = '' unless (exists($self->{__PRERUN_MODE})); # Was data provided? if (defined($prerun_mode)) { # Are we allowed to set prerun_mode? - if (exists($c->{__PRERUN_MODE_LOCKED})) { + if (exists($self->{__PRERUN_MODE_LOCKED})) { # Not allowed! Throw an exception. croak("prerun_mode() can only be called within cgiapp_prerun()! Error"); } else { # If data is provided, set it! - $c->{__PRERUN_MODE} = $prerun_mode; + $self->{__PRERUN_MODE} = $prerun_mode; } } # If we've gotten this far, return the value! - return $c->{__PRERUN_MODE}; + return $self->{__PRERUN_MODE}; } sub get_current_runmode { - my $c = shift; + my $self = shift; # It's OK if we return undef if this method is called too early - return $c->{__CURRENT_RUNMODE}; + return $self->{__CURRENT_RUNMODE}; } @@ -609,13 +605,13 @@ sub _send_headers { - my $c = shift; - my $q = $c->query; - my $type = $c->header_type; + my $self = shift; + my $q = $self->query; + my $type = $self->header_type; return - $type eq 'redirect' ? $q->redirect( $c->header_props ) - : $type eq 'header' ? $q->header ( $c->header_props ) + $type eq 'redirect' ? $q->redirect( $self->header_props ) + : $type eq 'header' ? $q->header ( $self->header_props ) : $type eq 'none' ? '' : croak "Invalid header_type '$type'" } @@ -626,7 +622,7 @@ # have come to rely on it, so any changes here should be # made with great care or avoided. sub _cap_hash { - my $c = shift; + my $self = shift; my $rhash = shift; my %hash = map { my $k = $_; @@ -658,10 +654,10 @@ # ( setup() can even be skipped for common cases. See docs below. ) sub setup { - my $c = shift; - $c->start_mode('mode1'); - $c->mode_param('rm'); - $c->run_modes( + my $self = shift; + $self->start_mode('mode1'); + $self->mode_param('rm'); + $self->run_modes( 'mode1' => 'do_stuff', 'mode2' => 'do_more_stuff', 'mode3' => 'do_something_else' @@ -687,7 +683,7 @@ CGI::Application judiciously avoids employing technologies and techniques which would bind a developer to any one set of tools, operating system or web server. -It is lightweight in turns of memory usage, making it suitable for common CGI +It is lightweight in terms of memory usage, making it suitable for common CGI environments, and a high performance choice in persistent environments like FastCGI or mod_perl. @@ -737,30 +733,30 @@ use CGI::Application::Plugin::DBH; sub setup { - my $c = shift; - $c->start_mode('mode1'); - $c->run_modes( + my $self = shift; + $self->start_mode('mode1'); + $self->run_modes( 'mode1' => 'showform', 'mode2' => 'showlist', 'mode3' => 'showdetail' ); # Connect to DBI database, with the same args as DBI->connect(); - $c->dbh_config(); + $self->dbh_config(); } sub teardown { - my $c = shift; + my $self = shift; # Disconnect when we're done, (Although DBI usually does this automatically) - $c->dbh->disconnect(); + $self->dbh->disconnect(); } sub showform { - my $c = shift; + my $self = shift; # Get CGI query object - my $q = $c->query(); + my $q = $self->query(); my $output = ''; $output .= $q->start_html(-title => 'Widget Search Form'); @@ -775,13 +771,13 @@ } sub showlist { - my $c = shift; + my $self = shift; # Get our database connection - my $dbh = $c->dbh(); + my $dbh = $self->dbh(); # Get CGI query object - my $q = $c->query(); + my $q = $self->query(); my $widgetcode = $q->param("widgetcode"); my $output = ''; @@ -806,13 +802,13 @@ } sub showdetail { - my $c = shift; + my $self = shift; # Get our database connection - my $dbh = $c->dbh(); + my $dbh = $self->dbh(); # Get CGI query object - my $q = $c->query(); + my $q = $self->query(); my $widgetid = $q->param("widgetid"); my $output = ''; @@ -951,8 +947,8 @@ my $app = WebApp->new(PARAMS => { cfg_file => 'config.pl' }); # Later in your app: - my %cfg = $c->cfg() - # or ... $c->cfg('HTML_ROOT_DIR'); + my %cfg = $self->cfg() + # or ... $self->cfg('HTML_ROOT_DIR'); See the list of of plugins below for more config file integration solutions. @@ -1001,17 +997,17 @@ Your setup() method might be implemented something like this: sub setup { - my $c = shift; - $c->tmpl_path('/path/to/my/templates/'); - $c->start_mode('putform'); - $c->error_mode('my_error_rm'); - $c->run_modes({ + my $self = shift; + $self->tmpl_path('/path/to/my/templates/'); + $self->start_mode('putform'); + $self->error_mode('my_error_rm'); + $self->run_modes({ 'putform' => 'my_putform_func', 'postdata' => 'my_data_func' }); - $c->param('myprop1'); - $c->param('myprop2', 'prop2value'); - $c->param('myprop3', ['p3v1', 'p3v2', 'p3v3']); + $self->param('myprop1'); + $self->param('myprop2', 'prop2value'); + $self->param('myprop3', ['p3v1', 'p3v2', 'p3v3']); } However, often times all that needs to be in setup() is defining your run modes @@ -1050,7 +1046,7 @@ package MySuperclass; use base 'CGI::Application'; sub cgiapp_init { - my $c = shift; + my $self = shift; # Perform some project-specific init behavior # such as to load settings from a database or file. } @@ -1088,7 +1084,7 @@ package MySuperclass; use base 'CGI::Application'; sub cgiapp_prerun { - my $c = shift; + my $self = shift; # Perform some project-specific init behavior # such as to implement run mode specific # authorization functions. @@ -1139,7 +1135,7 @@ cgiapp_postrun() method might be implemented as follows: sub cgiapp_postrun { - my $c = shift; + my $self = shift; my $output_ref = shift; # Enclose output HTML table @@ -1248,12 +1244,28 @@ LCGI::Application::Plugin::Stream can help if you want to return a stream and not a file. It features a simple syntax and MIME-type detection. +B + +You may specify an API-compatible alternative to HTML::Template by overriding +C. This method should return the class name of your template +system. The default simply returns "HTML::Template". The alternate class should +provide at least the following parts of the HTML::Template API: + + $t = $class->new( scalarref => ... ); # If you use scalarref templates + $t = $class->new( filehandle => ... ); # If you use filehandle templates + $t = $class->new( filename => ... ); + $t->param(...); + +Example implementation: + + sub html_tmpl_class { 'HTML::Template::Pro' } + B Plugin authors will be interested to know that you can register a callback that will be executed just before load_tmpl() returns: - $c->add_callback('load_tmpl',\&your_method); + $self->add_callback('load_tmpl',\&your_method); When C is executed, it will be passed three arguments: @@ -1432,7 +1444,7 @@ behavior, it is possible to catch this exception by implementing a run mode with the reserved name "AUTOLOAD": - $c->run_modes( + $self->run_modes( "AUTOLOAD" => \&catch_my_exception ); @@ -1442,7 +1454,7 @@ receive, as an argument, the name of the run mode which invoked it: sub catch_my_exception { - my $c = shift; + my $self = shift; my $intended_runmode = shift; my $output = "Looking for '$intended_runmode', but found 'AUTOLOAD' instead"; @@ -1607,15 +1619,15 @@ B<Example of redirecting>: sub some_redirect_mode { - my $c = shift; + my $self = shift; # do stuff here.... - $c->header_type('redirect'); - $c->header_props(-url=> "http://site/path/doc.html" ); + $self->header_type('redirect'); + $self->header_props(-url=> "http://site/path/doc.html" ); } To simplify that further, use LCGI::Application::Plugin::Redirect: - return $c->redirect('http://www.example.com/'); + return $self->redirect('http://www.example.com/'); Setting the header to 'none' may be useful if you are streaming content. In other contexts, it may be more useful to set C<$ENV{CGI_APP_RETURN_ONLY} = 1;>, @@ -1626,12 +1638,14 @@ =cut +sub html_tmpl_class { 'HTML::Template' } + sub load_tmpl { - my $c = shift; + my $self = shift; my ($tmpl_file, @extra_params) = @_; # add tmpl_path to path array if one is set, otherwise add a path arg - if (my $tmpl_path = $c->tmpl_path) { + if (my $tmpl_path = $self->tmpl_path) { my @tmpl_paths = (ref $tmpl_path eq 'ARRAY') ? @$tmpl_path : $tmpl_path; my $found = 0; for( my $x = 0; $x < @extra_params; $x += 2 ) { @@ -1650,26 +1664,28 @@ %ht_params = () unless keys %ht_params; # Define our extension if doesn't already exist; - $c->{__CURRENT_TMPL_EXTENSION} = '.html' unless defined $c->{__CURRENT_TMPL_EXTENSION}; + $self->{__CURRENT_TMPL_EXTENSION} = '.html' unless defined $self->{__CURRENT_TMPL_EXTENSION}; # Define a default template name based on the current run mode unless (defined $tmpl_file) { - $tmpl_file = $c->get_current_runmode . $c->{__CURRENT_TMPL_EXTENSION}; + $tmpl_file = $self->get_current_runmode . $self->{__CURRENT_TMPL_EXTENSION}; } - $c->call_hook('load_tmpl', \%ht_params, \%tmpl_params, $tmpl_file); + $self->call_hook('load_tmpl', \%ht_params, \%tmpl_params, $tmpl_file); + + my $ht_class = $self->html_tmpl_class; + eval "require $ht_class;" || die "require $ht_class failed: $@"; - require HTML::Template; # let's check $tmpl_file and see what kind of parameter it is - we # now support 3 options: scalar (filename), ref to scalar (the # actual html/template content) and reference to FILEHANDLE my $t = undef; if ( ref $tmpl_file eq 'SCALAR' ) { - $t = HTML::Template->new_scalar_ref( $tmpl_file, %ht_params ); + $t = $ht_class->new( scalarref => $tmpl_file, %ht_params ); } elsif ( ref $tmpl_file eq 'GLOB' ) { - $t = HTML::Template->new_filehandle( $tmpl_file, %ht_params ); + $t = $ht_class->new( filehandle => $tmpl_file, %ht_params ); } else { - $t = HTML::Template->new_file($tmpl_file, %ht_params); + $t = $ht_class->new( filename => $tmpl_file, %ht_params); } if (keys %tmpl_params) { @@ -1711,7 +1727,7 @@ to use directly. Example: sub some_method { - my $c = shift; + my $self = shift; return 'run_mode_x'; } @@ -1765,11 +1781,11 @@ =cut sub mode_param { - my $c = shift; + my $self = shift; my $mode_param; # First use? Create new __MODE_PARAM - $c->{__MODE_PARAM} = 'rm' unless (exists($c->{__MODE_PARAM})); + $self->{__MODE_PARAM} = 'rm' unless (exists($self->{__MODE_PARAM})); my %p; # expecting a scalar or code ref @@ -1783,8 +1799,8 @@ %p = @_; $mode_param = $p{param}; - if ( $p{path_info} && $c->query->path_info() ) { - my $pi = $c->query->path_info(); + if ( $p{path_info} && $self->query->path_info() ) { + my $pi = $self->query->path_info(); my $idx = $p{path_info}; # two cases: negative or positive index @@ -1806,10 +1822,10 @@ # If data is provided, set it if (defined $mode_param and length $mode_param) { - $c->{__MODE_PARAM} = $mode_param; + $self->{__MODE_PARAM} = $mode_param; } - return $c->{__MODE_PARAM}; + return $self->{__MODE_PARAM}; } @@ -1825,15 +1841,15 @@ package WebApp; use base 'CGI::Application'; sub cgiapp_prerun { - my $c = shift; + my $self = shift; # Get the web user name, if any - my $q = $c->query(); + my $q = $self->query(); my $user = $q->remote_user(); # Redirect to login, if necessary unless ($user) { - $c->prerun_mode('login'); + $self->prerun_mode('login'); } } @@ -1892,7 +1908,7 @@ that contain JavaScript. Direct testing is also easy. CGI::Application will normally print the output of it's -run modes directly to STDOUT. This can be surprised with an enviroment variable, +run modes directly to STDOUT. This can be suppressed with an enviroment variable, CGI_APP_RETURN_ONLY. For example: $ENV{CGI_APP_RETURN_ONLY} = 1; @@ -2034,23 +2050,23 @@ $class->add_callback('init', \&some_other_method); # Object-based: callback will only last for lifetime of this object - $c->add_callback('prerun', \&some_method); + $self->add_callback('prerun', \&some_method); # If you want to create a new hook location in your application, # You'll need to know about the following two methods to create # the hook and call it. # Create a new hook - $c->new_hook('pretemplate'); + $self->new_hook('pretemplate'); # Then later execute all the callbacks registered at this hook - $c->call_hook('pretemplate'); + $self->call_hook('pretemplate'); B<Callback Methods> =head3 add_callback() - $c->add_callback ('teardown', \&callback); + $self->add_callback ('teardown', \&callback); $class->add_callback('teardown', 'method'); The add_callback method allows you to register a callback @@ -2071,7 +2087,7 @@ method: # add object-based callback - $c->add_callback('teardown', \&callback); + $self->add_callback('teardown', \&callback); # add class-based callbacks $class->add_callback('teardown', \&callback); @@ -2124,8 +2140,8 @@ if (ref $c_or_class) { # Install in object - my $c = $c_or_class; - push @{ $c->{__INSTALLED_CALLBACKS}{$hook} }, $callback; + my $self = $c_or_class; + push @{ $self->{__INSTALLED_CALLBACKS}{$hook} }, $callback; } else { # Install in class @@ -2137,7 +2153,7 @@ =head3 new_hook(HOOK) - $c->new_hook('pretemplate'); + $self->new_hook('pretemplate'); The C method can be used to create a new location for developers to register callbacks. It takes one argument, a hook name. The hook location is @@ -2158,7 +2174,7 @@ =head3 call_hook(HOOK) - $c->call_hook('pretemplate', @args); + $self->call_hook('pretemplate', @args); The C method is used to executed the callbacks that have been registered at the given hook. It is used in conjunction with the C method which @@ -2181,8 +2197,8 @@ =cut sub call_hook { - my $c = shift; - my $app_class = ref $c || $c; + my $self = shift; + my $app_class = ref $self || $self; my $hook = lc shift; my @args = @_; @@ -2191,9 +2207,9 @@ my %executed_callback; # First, run callbacks installed in the object - foreach my $callback (@{ $c->{__INSTALLED_CALLBACKS}{$hook} }) { + foreach my $callback (@{ $self->{__INSTALLED_CALLBACKS}{$hook} }) { next if $executed_callback{$callback}; - eval { $c->$callback(@args); }; + eval { $self->$callback(@args); }; $executed_callback{$callback} = 1; die "Error executing object callback in $hook stage: $@" if $@; } @@ -2201,10 +2217,10 @@ # Next, run callbacks installed in class hierarchy # Cache this value as a performance boost - $c->{__CALLBACK_CLASSES} ||= [ Class::ISA::self_and_super_path($app_class) ]; + $self->{__CALLBACK_CLASSES} ||= [ Class::ISA::self_and_super_path($app_class) ]; # Get list of classes that the current app inherits from - foreach my $class (@{ $c->{__CALLBACK_CLASSES} }) { + foreach my $class (@{ $self->{__CALLBACK_CLASSES} }) { # skip those classes that contain no callbacks next unless exists $INSTALLED_CALLBACKS{$hook}{$class}; @@ -2212,7 +2228,7 @@ # call all of the callbacks in the class foreach my $callback (@{ $INSTALLED_CALLBACKS{$hook}{$class} }) { next if $executed_callback{$callback}; - eval { $c->$callback(@args); }; + eval { $self->$callback(@args); }; $executed_callback{$callback} = 1; die "Error executing class callback in $hook stage: $@" if $@; } diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/CGI-Application-4.11/MANIFEST new/CGI-Application-4.20/MANIFEST --- old/CGI-Application-4.11/MANIFEST 2008-08-10 17:34:30.000000000 +0200 +++ new/CGI-Application-4.20/MANIFEST 2008-11-02 01:40:57.000000000 +0100 @@ -13,6 +13,7 @@ Makefile.PL README t/basic.t +t/default_runmode.t t/mailform.t t/prerun.t t/getquery.t diff -urN --exclude=CVS --exclude=.cvsignore --exclude=.svn --exclude=.svnignore old/CGI-Application-4.11/t/default_runmode.t new/CGI-Application-4.20/t/default_runmode.t --- old/CGI-Application-4.11/t/default_runmode.t 1970-01-01 01:00:00.000000000 +0100 +++ new/CGI-Application-4.20/t/default_runmode.t 2008-09-27 05:23:31.000000000 +0200 @@ -0,0 +1,31 @@ +use strict; +use warnings; + +use Test::More tests => 1; + +$ENV{'CGI_APP_RETURN_ONLY'} = 1; # don't print + +{ + package WithStartIssue; + + use base 'CGI::Application'; + + # register custom "start" run mode. + # this is what CAP::AutoRunmode and CAP::RunmodeDeclare do. + __PACKAGE__->add_callback('init' => sub { + shift->run_modes('start' => 'my_start'); + } + ); + + sub my_start { return 'my start' } + + # don't output a header + sub cgiapp_prerun { + shift->header_type('none'); + } +} + +my $issue = WithStartIssue->new; +my $out = $issue->run; + +is $out, 'my start'; ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Remember to have fun... -- To unsubscribe, e-mail: opensuse-commit+unsubscribe@opensuse.org For additional commands, e-mail: opensuse-commit+help@opensuse.org