CGI-Portable
view release on metacpan or search on metacpan
lib/CGI/Portable/AppStatic.pm view on Meta::CPAN
5.004
=head2 Standard Modules
I<none>
=head2 Nonstandard Modules
CGI::Portable 0.50
=cut
######################################################################
use CGI::Portable 0.50;
######################################################################
=head1 SYNOPSIS
=head2 Simple program that returns a static HTML page:
#!/usr/bin/perl
use strict;
use warnings;
require CGI::Portable;
my $globals = CGI::Portable->new();
my %CONFIG = (
high_http_status_code => '200 OK',
high_http_content_type => 'text/html',
high_page_title => 'Simple AppStatic Demo',
high_page_author => 'Darren Duncan',
high_page_meta => {
keywords => 'HTTP, HTML, Perl, Static',
},
high_page_style_code => [
'body {background-color: white; background-image: none}',
'h1, h2 {text-align: center}',
'td {text-align: left; vertical-align: top}',
],
high_page_body => __endquote,
<h1>Simple AppStatic Demo</h1>
<p>This page is a trivial example of what can be done with CGI::Portable
when you want your script to always return the same screen. It is more
common, however, that your script would contain many screens of which some
are dynamic and some are static.</p>
<h2>Oh, A Table!</h2>
<table><tr>
<td>Question:</td><td>Answer!</td>
</tr><tr>
<td>Another Question:</td>
<td>This is a really really long answer. It just keeps going on and on and
on and on and on and on and on and on and on. However, the short question
should stay top aligned with the long answer due to the stylesheet.</td>
</tr></table>
__endquote
);
$globals->set_prefs( \%CONFIG );
$globals->call_component( 'CGI::Portable::AppStatic' );
require CGI::Portable::AdapterCGI;
my $io = CGI::Portable::AdapterCGI->new();
$io->send_user_output( $globals );
1;
=head2 Simple program that returns an HTTP redirection header:
my %CONFIG = (
high_http_status_code => '301 Moved',
high_http_window_target => 'nyx_demo_file_window',
high_http_redirect_url => 'http://www.nyxmydomain.net/dir/file.html',
);
=head2 Simple program that returns a bit of binary data:
my %CONFIG = (
high_http_status_code => '200 OK',
high_http_content_type => 'application/xxxencoded',
high_http_body => pack( 'H8', '5065726c' ),
high_http_body_is_binary => 1,
);
=head1 DESCRIPTION
This Perl 5 object class is a simple encapsulated application, or "component",
that runs in the CGI::Portable environment. It allows you to define a complete
static "program response screen" within the standard "preferences" config file
without having to write your own "application" to do it. Or, to be specific,
this module allows you to set any CGI::Portable 'Response' properties by
providing a like-named "preference" with each new value, rather than having to
explicitely call each appropriate accessor method. This module is designed to be
easily subclassed by your own application components, so they can do the same
things while you only need to program the interesting dynamic functionality.
An example scenario has users of your subclassed application using AppStatic
methods to apply a common header or footer or stylesheet to every screen.
=cut
######################################################################
# Constant values used by this class:
# root property/preference names applied as "low/high" scalars:
my @SCALAR_PREFS = qw(
http_status_code http_window_target http_content_type
http_redirect_url http_body http_body_is_binary
page_prologue page_title page_author
);
# root property/preference names applied as "low/high" list refs:
my @PREFS_TO_SET = qw(
http_cookies http_headers page_meta page_style_sources
page_style_code page_head page_frameset_attributes
page_frameset page_body_attributes page_body
);
# root property/preference names applied as "add" list refs:
lib/CGI/Portable/AppStatic.pm view on Meta::CPAN
high_http_body_is_binary - boolean
add_http_cookies - array of encoded cookie strings
add_http_headers - hash of header names and values
=head2 These preferences are specifically for HTML pages:
low_page_prologue - string (override the DOCTYPE tag)
low_page_title - string
low_page_author - string
low_page_meta - hash of meta-tag names and values
low_page_style_sources - array of strings (urls)
low_page_style_code - array of strings (raw code)
low_page_head - array
low_page_frameset_attributes - hash
low_page_frameset - array of hashes (each hash is attributes for new FRAME tag)
low_page_body_attributes - hash
low_page_body - array
high_page_prologue - string (override the DOCTYPE tag)
high_page_title - string
high_page_author - string
high_page_meta - hash of meta-tag names and values
high_page_style_sources - array of strings (urls)
high_page_style_code - array of strings (raw code)
high_page_head - array
high_page_frameset_attributes - hash
high_page_frameset - array of hashes (each hash is attributes for new FRAME tag)
high_page_body_attributes - hash
high_page_body - array
add_page_meta - hash of meta-tag names and values
add_page_style_sources - array of strings (urls)
add_page_style_code - array of strings (raw code)
add_page_frameset_attributes - hash
add_page_body_attributes - hash
prepend_page_head - array
prepend_page_frameset - array of hashes (each hash is attributes for new FRAME tag)
prepend_page_body - array
append_page_head - array
append_page_frameset - array of hashes (each hash is attributes for new FRAME tag)
append_page_body - array
page_search_and_replace - hash (keys are tokens to search for; values replace)
=head1 PRIVATE METHODS FOR USE BY SUBCLASSES
=head2 set_static_low_replace( GLOBALS )
This method will apply all of the "low" priority preferences, which replace
any respective properties.
=cut
######################################################################
sub set_static_low_replace {
my ($self, $globals) = @_;
my $rh_prefs = $globals->get_prefs_ref();
foreach my $base (@SCALAR_PREFS) {
if( defined( $rh_prefs->{"low_$base"} ) ) {
eval "\$globals->$base( \$rh_prefs->{low_$base} );";
$@ and die;
}
}
foreach my $base (@PREFS_TO_SET) {
if( defined( $rh_prefs->{"low_$base"} ) ) {
eval "\$globals->set_$base( \$rh_prefs->{low_$base} );";
$@ and die;
}
}
}
######################################################################
=head2 set_static_high_replace( GLOBALS )
This method will apply all of the "high" priority preferences, which replace
any respective properties.
=cut
######################################################################
sub set_static_high_replace {
my ($self, $globals) = @_;
my $rh_prefs = $globals->get_prefs_ref();
foreach my $base (@SCALAR_PREFS) {
if( defined( $rh_prefs->{"high_$base"} ) ) {
eval "\$globals->$base( \$rh_prefs->{high_$base} );";
$@ and die;
}
}
foreach my $base (@PREFS_TO_SET) {
if( defined( $rh_prefs->{"high_$base"} ) ) {
eval "\$globals->set_$base( \$rh_prefs->{high_$base} );";
$@ and die;
}
}
}
######################################################################
=head2 set_static_attach_unordered( GLOBALS )
This method will apply all of the "add" preferences, which try to add values to
any respective properties without deleting previous values. Previous values
are only deleted where the properties are hashes and new hash keys are the same
as existing ones; different keys do not conflict.
=cut
######################################################################
sub set_static_attach_unordered {
my ($self, $globals) = @_;
my $rh_prefs = $globals->get_prefs_ref();
foreach my $base (@PREFS_TO_ADD) {
if( defined( $rh_prefs->{"add_$base"} ) ) {
eval "\$globals->add_$base( \$rh_prefs->{add_$base} );";
$@ and die;
}
}
}
######################################################################
=head2 set_static_attach_ordered( GLOBALS )
This method will apply all of the "append" and "prepend" preferences, which will
always add to their respective properties without deleting previous values.
=cut
######################################################################
sub set_static_attach_ordered {
my ($self, $globals) = @_;
my $rh_prefs = $globals->get_prefs_ref();
foreach my $base (@PREFS_TO_PEND) {
if( defined( $rh_prefs->{"append_$base"} ) ) {
eval "\$globals->append_$base( \$rh_prefs->{append_$base} );";
$@ and die;
}
}
foreach my $base (@PREFS_TO_PEND) {
if( defined( $rh_prefs->{"prepend_$base"} ) ) {
eval "\$globals->prepend_$base( \$rh_prefs->{prepend_$base} );";
$@ and die;
}
}
}
######################################################################
=head2 set_static_search_and_replace( GLOBALS )
This method will apply the page_search_and_replace preference, and should be
run later than all of the other methods, to affect their results also.
=cut
######################################################################
sub set_static_search_and_replace {
my ($self, $globals) = @_;
$globals->page_search_and_replace(
$globals->pref( 'page_search_and_replace' ) );
}
######################################################################
1;
__END__
=head1 AUTHOR
Copyright (c) 1999-2004, Darren R. Duncan. All rights reserved. This module
is free software; you can redistribute it and/or modify it under the same terms
as Perl itself. However, I do request that this copyright information and
credits remain attached to the file. If you modify this module and
redistribute a changed version then please attach a note listing the
modifications. This module is available "as-is" and the author can not be held
accountable for any problems resulting from its use.
I am always interested in knowing how my work helps others, so if you put this
module to use in any of your own products or services then I would appreciate
(but not require) it if you send me the website url for said product or
service, so I know who you are. Also, if you make non-proprietary changes to
the module because it doesn't work the way you need, and you are willing to
make these freely available, then please send me a copy so that I can roll
desirable changes into the main release.
Address comments, suggestions, and bug reports to B<perl@DarrenDuncan.net>.
=head1 SEE ALSO
perl(1), CGI::Portable.
=cut
( run in 0.685 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )