<![CDATA[
#!/usr/bin/perl -w
use strict;
package Handout;
use base qw/CGI::Application/;
our $VERSION = '1.1';
# Perl CPAN libraries
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use CGI::Pretty qw/:html3/;
use CGI::FormBuilder;
# use Data::Dumper; # debug only
use File::Slurp; # easy, quick file access
use File::Basename; # portable way to see filenames
use Pod::Usage; # help screens are in pod format
# Application libraries
use Info;
# File::Slurp::append_file(LOG, ("ms nsrender $text\n")) if DEBUG;
use constant {
DEBUG => 1,
NOBUG => 0,
LOG => "data/log",
};
# Globals
our $method = $ENV{REQUEST_METHOD} || 'POST';
$method = 'GET' if DEBUG;
our $hot = 0; # true after submitted is checked
# my %args = _args(@_);
# handle either ->field($name) or ->field(name => $name)
# my $name = (@_ % 2 == 0) ? '' : shift();
# my %args = _args(@_);
# $args{name} ||= $name;
sub _args (;@) {
die "Odd number of arguments passed into ", (caller(1))[3]
unless (@_ % 2 == 0);
# strip off any leading '-opt'
my @args;
while (@_) {
(my $k = shift) =~ s/^-//;
push @args, $k, shift;
}
return @args;
}
sub setup {
my $self = shift;
$self->start_mode('splash');
$self->mode_param('rm');
$self->tmpl_path('./');
$hot = 0;
$self->run_modes(
select_handout => 'select_handout',
select_topics => 'select_topics',
select_info => 'select_info',
show_handout => 'show_handout',
import_handout => 'import_handout',
splash => 'splash',
);
}
# Filter all screens for common look and feel
sub cgiapp_postrun {
my ($self, $body_ref) = @_;
# Creating common look
my $output;
# Look for handout output
if ( $$body_ref =~ /\<body/m ) {
$output = $$body_ref;
# Use Interface look
} else {
$output = "<link rel='stylesheet' href='/d3c.css'>";
$output .= "<body><center><br><br>" . $$body_ref .
"</center></body>";
}
# Return by reference
$$body_ref = $output;
}
sub splash {
my $self = shift;
my $text = shift || "TCM Handouts Main Menu";
my @fields = qw();
my $form = CGI::FormBuilder->new(
method => $method,
name => 'splash',
fields => \@fields,
submit => [ 'Select Handout', 'Import Handout', 'Help'],
reset => 0,
text => 'Select or Import a Handout',
);
$form->field(name => 'rm', value => "splash", force => 1,type => 'hidden');
return $form->render( text => $text ) unless $form->submitted && ! $hot;
if ( $form->submitted eq 'Select Handout' ) {
return $self->select_handout();
} elsif ( $form->submitted eq 'Import Handout' ) {
return $self->import_handout();
} elsif ( $form->submitted eq 'Help' ) {
return $self->help();
} elsif ( $form->submitted eq 'Return' ) {
$text = "Welcome back from Handout Help";
}
return $form->render( text => $text );
}
# Use pod for help screen
sub help {
my ($self) = @_;
# Get the help as an html source file
my $filename = $0;
$filename =~ s/cgi$/pod/;
my $output = `pod2html handout.pod`;
# Return the source with a submit back to splash
my @fields = qw();
my $form = CGI::FormBuilder->new(
method => $method,
name => 'Handout Help',
fields => \@fields,
submit => [ 'Return' ],
reset => 0,
text => "Handout Help",
);
$form->field(name => 'rm', value => "splash", force => 1,
type => 'hidden');
$output =~ s/\<\/body\>//;
$output =~ s/\<\/html\>//;
$output .= $form->render;
$output .= "</body>";
return $output;
}
sub select_handout {
my $self = shift;
my $text = shift || "TCM Handouts selection";
my @handouts = Info->get_all;
my @fields = qw(handout_name);
my $form = CGI::FormBuilder->new(
method => $method,
name => 'select_handout',
fields => \@fields,
required => [ qw(handout_name) ],
values => { handout_name => $handouts[0] },
options => { handout_name => \@handouts },
submit => [ 'Select Topics', 'Main Menu', ],
reset => 0,
text => 'Select a handout',
);
$form->field(name => 'rm', value => "select_handout",force => 1, type => 'hidden');
return $self->splash("Import a handout first") unless scalar @handouts;
if ( $form->submitted eq 'Select Topics' ) {
return $self->select_topics( $form->field('handout_name') );
} elsif ( $form->submitted eq 'Main Menu' ) {
return $self->splash();
}
return $form->render( text => $text );
}
sub select_topics {
my $self = shift;
my $name = shift || $self->query->param('handout_name')
|| die "Missing handout name\n";
my $info = Info->new($name);
my @fields = $info->topics;
my $form = CGI::FormBuilder->new(
method => $method,
name => 'select_topics',
fields => \@fields,
submit => [ 'Select Info', 'Main Menu' ],
reset => 0,
text => 'Select Topics',
options => $info->topic_options,
);
$form->field(name => 'rm', value => "select_topics",
force => 1, type => 'hidden');
$form->field(name => 'handout_name', value => $name,
force => 1,type => 'hidden');
if ( $form->submitted eq 'Select Info' ) {
return $self->select_info($form, 1);
} elsif ( $form->submitted eq 'Main Menu' ) {
return $self->splash();
}
return $form->render( text => "Select the topics" );
}
sub select_info {
my ($self, $first) = @_;
my $name = $self->query->param('handout_name')
|| die "Missing handout name\n";
my $info = Info->new($name);
my @topics = ();
my $topics = "";
# build new information
if ( $first ) {
my $item;
foreach my $topic ( $info->topics ) {
if ( $first->field($topic) ) {
$item = $topic;
$item =~ s/topic_//;
push @topics, $item;
}
}
$topics = join(" ", @topics);
} else {
$topics = $self->query->param('topic_list');
@topics = split( /\s+/, $topics );
}
my @fields = $info->info( @topics );;
my $form = CGI::FormBuilder->new(
method => $method,
name => 'select_info',
fields => \@fields,
submit => [ 'Show Handout', 'Main Menu' ],
reset => 0,
text => 'Select Handout Info',
options => $info->info_options( @topics ),
);
$info->info_fields($form, @topics);
$form->field(name => 'rm', value => "select_info",
force => 1, type => 'hidden');
$form->field(name => 'handout_name', value => $name,
force => 1,type => 'hidden');
$form->field(name => 'topic_list', value => $topics,
force => 1,type => 'hidden');
if ( $form->submitted eq 'Show Handout' ) {
return $self->show_handout($info, $form, \@topics);
} elsif ( $form->submitted eq 'Main Menu' ) {
return $self->splash();
}
return $form->render( text => "Select the Info" );
}
sub show_handout {
my ($self, $info, $picks, $topics) = @_;
return $self->splash() unless $info;
my $name = $self->query->param('handout_name')
|| die "Missing handout name\n";
$info = Info->new($name) unless $info;
my @topics = ();
@topics = @$topics if $topics;
$topics = "";
# build new information
if ( $picks ) {
$topics = join(" ", @topics);
} else {
$picks = {};
$topics = $self->query->param('topic_list');
@topics = split( /\s+/, $topics );
}
my %labels = ();
my @fields = $info->fields( $picks, \%labels, @topics );;
my $form = CGI::FormBuilder->new(
method => $method,
name => 'select_info',
fields => \@fields,
labels => \%labels,
submit => [ 'Main Menu' ],
reset => 0,
text => 'Handout',
values => $info->show_options( $picks, @topics ),
);
$info->show_fields($picks, $form, @topics);
$form->field(name => 'rm', value => "show_handout",
force => 1, type => 'hidden');
$form->field(name => 'handout_name', value => $name,
force => 1,type => 'hidden');
$form->field(name => 'topic_list', value => $topics,
force => 1,type => 'hidden');
return "<body>" . $form->render( valign => "top" ) . "</body>";
}
sub import_handout {
my $self = shift;
my $text = shift || "Create a handout name and import topics";
my @fields = qw(handout_name filename );
my $form = CGI::FormBuilder->new(
enctype => 'multipart/form-data',
name => 'create_handout_topics',
method => 'POST',
fields => \@fields,
validate => {
handout_name => '/^[A-Za-z][\dA-Za-z_]{1,30}$/',
},
submit => [ 'Submit', 'Main Menu' ],
values => { handout_name => 'name_of_topics_file' },
text => 'Import a text handout file',
);
$form->field(name => 'handout_name', comment =>
'must be alphanumeric, can use underscores, under 30 characters');
$form->field(name => 'filename', type => 'file',
comment => "select a file");
$form->field(name => 'rm', value => "import_handout", force => 1,type => 'hidden');
# And then get to your file the same way as CGI.pm:
if ($form->submitted eq 'Submit' ) {
my $file = $form->field('filename');
my $name = $form->field('handout_name');
if ( $file and $name ) {
my $info = Info->import( $name, $file );
return $self->splash("Handout $name has been imported");
} else {
return $form->render(
text => "Handout name and filename are required to import a file");
}
} elsif ( $form->submitted eq 'Main Menu' ) {
return $self->splash();
} else {
return $form->render( text => $text );
}
}
1; # true returned for library load
__END__
=head1 NAME
Handout - Web Application for TCM handouts
=head1 SYNOPSIS
$app = new Handout;
$app->run();
=head1 DESCRIPTION
A web application to respond with TCM Handouts as needed from
a list of keywords.
o topic
o info
o table rows
o table columns
First pass selects topics by check. Second pass selects info
by check. A table and its columns or rows may be selected
as well. Handouts are show as separate screens so that one
may keep selecting and choosing the proper handout.
=head1 Run Modes
In this framework all screens are accomplished with run modes
which encapsulates all of our electronic web commerce product.
All files have to be written to a accessible directory for
everybody -- data.
=over 4
=item splash
Main menu screen.
=item select_handout
Select a handout topics file from a list.
=item select_topics
Select the topics desired from the handout file.
=item select_info
Select the information for the handout.
=item show_handout
Show in a separate screen the selected items for printing.
=item import_handout
Import a handout file from the PC to the server which holds
a copy of the files. CAUTION: Any imported file may delete
the handout file that is already there.
=back 4
=head1 Object Design
Handout.pm is a CGI::Application object which manages all
screens.
The handout object uses the Info.pm object to manage all data.
=head1 TODO
x framework
x reader
x parser
x import
x topics
x info
x simple
x table
x show
o image
The ability to add images would help for instructions for
exercises or other visual related information.
=head1 ENVIRONMENT VARIABLES
REQUEST_METHOD - form method defaults to POST
=head1 BUGS
The table caption is repeated twice.
Small tables will wrap the caption on the table.
=head1 AUTHOR
David Scott L<leapingfrog@yahoo.com>
=cut
]]>