<![CDATA[
#!/usr/bin/perl -w
use strict;
=head1 NAME
Info - Object to manage a topic information.
=head1 SYNOPSIS
use Info;
@handouts = Info->get_all();
$info = Info->new($name);
$info = Info->import($name, $file);
=head1 DESCRIPTION
An info class makes an object for all handout
information.
=head1 USAGE
Isolate all handouts through this object.
=head1 AUTHOR
David Scott L<leapingfrog@yahoo.com>
=head1 METHODS
These methods suppport Info objects:
=over 4
=cut
package Info;
use fields qw( name dir file topic data );
# Libraries used to build a handout
use Carp;
use CGI qw/:standard *table/;
# use CSV;
use constant {
NULL => "\0",
};
# Global name space
our $VERSION = '1.1';
our $AUTOLOAD;
our @TOPIC = ( '?', 'A' .. 'Z', 'a' .. 'z' ); # MAX_TOPICS = 54
=item @handouts = Info->get_all();
Returns a list of all handouts.
=item $info->get_all()
Returns a list of all handouts.
=cut
sub get_all {
my $self = shift;
my @handouts = ();
my $dir = get_dir();
@handouts = File::Slurp::read_dir($dir);
return @handouts;
}
=item SUPER::new($name);
Info can be inherited, use this call to
properly initialize the base object.
=item $info = Info->new($name);
Returns an info object that manages the current handout environment.
=cut
sub new {
my $self = shift;
my $name = shift || return undef;
unless (ref $self) {
$self = fields::new($self);
}
return $self->init($name);
}
=item $info = Info->import($name, $file);
Create a new info file from an import of a text file
from a workstation or from a local file.
Local files are read into memory and written back out.
Large files would require a file copy.
=cut
sub import {
my $self = shift;
my $name = shift || return undef;
my $file = shift || return undef;
# setup directory if not there
my $dir = get_dir();
# file reference can come from anywhere
my $txt = "${dir}/${name}";
if ( ref($file) ) {
# import contents in file
open FILE, ">$txt" or die "Unable to write $txt: $!";
while (<$file>) {
# remove LineFeed to make a proper UNIX file
# CAUTION: may only be valid for text conversion
# CAUTION: tested on XP only
s/\r\n$/\n/;
print FILE;
}
close FILE;
# simple name must be a filename
} else {
# copy contents in file
my @lines = File::Slurp::read_file($file);
File::Slurp::write_file($txt, @lines);
}
unless (ref $self) {
$self = fields::new($self);
}
$self->init($name);
return $self;
}
=item Info fields
name - name of the Info must be unique for a user
dir - name of directory
file - name of file
topic - topic data
data - topic info data
=cut
# my $info = $self->init($name);
# initialize all variables & return $self or undef
sub init {
my $self = shift;
# initialize variables
$self->{name} = shift;
$self->{dir} = get_dir();
$self->{file} = "$self->{dir}/$self->{name}";
$self->parse;
return $self;
}
# $dir = get_dir();
# setup directory if not there
sub get_dir {
my $dir = "data";
mkdir $dir unless -d $dir;
$dir .= "/handout";
mkdir $dir unless -d $dir;
return $dir;
}
# $self->parse;
# Parsing engine for handout data
# topic = array reference: by topic: 0, 1, ... n
# data = hash reference: by topic: 0, 1, ... n
# each hash is an array of info
# info: [ <text> [ [<list>] | <text> ] ... ]
# [ "[rows|columns] <text>, [list] ... ]"
sub parse {
my $self = shift;
open FILE, $self->file || die "Unable to open $self-file: $!";
my $it = -1; # iterate 0, 1, ... by topic
my ($info, $topic, $table) = (0,0,0); # gathering flags
my @topics = ();
my %info = (); # a hash of arrays organized by 0, 1, ...
my @data = (); # the array to save
while ( <FILE> ) {
chomp;
next if /^\s*$/; # ignore blank lines
next if /^\s/; # ignore lines with leading space
# look for keywords
if ( /^topic\s+(.*)$/ ) {
$info = $table = 0 if $it == -1; # ignore leading info /table
push @{$info{$it}}, [ @data ] if $info || $table;
$topic = 1;
$info = $table = 0;
++$it;
$info{$it} = [];
@data = ();
push @topics, $1;
} elsif ( /^info\s+(.*)$/ ) {
push @{$info{$it}}, [ @data ] if $info || $table;
$info = 1;
$topic = $table = 0;
@data = ();
push @data, $1; # ( $text )
} elsif ( /^table\srows\s+(.*)$/ ) {
push @{$info{$it}}, [ @data ] if $info || $table;
$table = 1;
$topic = $info = 0;
@data = ();
push @data, "rows $1"; # ( "rows $text" )
$_ = <FILE> || die "Table $1 not defined completely";
chomp;
/,/ || die "Table $data[0] not defined completely";
s/, /,/g;
push @data, [ split(/,/, $_) ];
$_ = <FILE> || die "Table $1 not defined completely";
chomp;
/,/ || die "Table $data[0] not defined completely";
s/, /,/g;
push @data, [ split(/,/, $_) ];
} elsif ( /^table\scolumns\s+(.*)$/ ) {
push @{$info{$it}}, [ @data ] if $info || $table;
$table = 1;
$topic = $info = 0;
@data = ();
push @data, "columns $1"; # ( "columns $text" )
$_ = <FILE> || die "Table $1 not defined completely";
chomp;
/,/ || die "Table $data[0] not defined completely";
s/, /,/g;
push @data, [ split(/,/, $_) ];
$_ = <FILE> || die "Table $1 not defined completely";
chomp;
/,/ || die "Table $data[0] not defined completely";
s/, /,/g;
push @data, [ split(/,/, $_) ];
# gather for keywords
} elsif ( $info ) {
push @data, $_; # ( $text, $text, ... )
# if ( /\.\s*$/ ) {
# push @data, $_; # ( $text, $text, ... )
# } elsif ( /,/ ) {
# push @data, [ split(/,/, $_) ]; # ( $text, [ $item, ...] )
# } else {
# push @data, $_; # ( $text, $text, ... )
# }
} elsif ( $table ) {
chomp;
/,/ || die "Table $data[0] not defined completely";
s/, /,/g;
push @data, [ split(/,/, $_) ]; # $( $text, [ $item, ...] )
} elsif ( $topic ) {
# ignore extra topic lines for now
}
}
# End of File may catch the last info or table
push @{$info{$it}}, [ @data ] if $info || $table;
# save topics and info data
$self->{topic} = \@topics;
$self->{data} = \%info;
}
=item $info->delete($product_name)
Remove a handout list completely.
=cut
sub delete {
my $self = shift;
my $info = $self->name;
my $dir = $self->dir;
# Delete the current info file
unlink "$dir/$info";
# Clean up current object
$self->{data} = undef;
}
=item $self->{data} = $info->restore();
Restore a information.
=cut
sub restore {
my $self = shift;
}
# $self->add_name()
# add a name to the products file, create it if it doesn't exist
sub add_name {
my $self = shift;
my $name = $self->name;
# Verify handout info name is within the "handouts" file
my $info_file = get_info_file();
my @handouts = ();
if ( -e $info_file ) {
@handouts = File::Slurp::read_file($info_file);
}
# Add name if it isn't already in the products file
if ( $name && ! grep ( /^$name$/, @handouts ) ) {
push @handouts, "$name\n";
File::Slurp::write_file($info_file, @handouts);
}
}
=back 4
=head1 Object methods
Info objects return information needed for display.
=over 4
=item topics
Return a list of topic fields.
=cut
sub topics {
my $self = shift;
die "invalid method call" unless ref($self);
my @topics;
foreach my $count ( 1 .. scalar @{$self->{topic}} ) {
push @topics, "topic_" . $count;
}
return @topics;
}
=item $options_ref = $info->topic_options;
Return a list of options for checkbox selection
of topics.
=cut
sub topic_options {
my $self = shift;
die "invalid method call" unless ref($self);
my $item;
my %topics = ();
foreach my $count ( 1 .. scalar @{$self->{topic}} ) {
$item = "topic_" . $count;
$topics{$item} = [ $self->{topic}->[$count-1] ];
}
return \%topics;
}
=item @fields = $info->info( @topics );
Return a list of topic and info fields.
=cut
sub info {
my ($self, @topics) = @_;
die "invalid method call" unless ref($self);
my @fields = ();
my $item;
my $data;
foreach my $topic ( @topics ) {
push @fields, "topic_" . $topic;
$data = $self->data->{$topic-1};
foreach my $count ( 1 .. scalar @$data ) {
$item = $data->[$count-1];
if ( $item->[0] =~ /^rows (.*)$/ ) {
push @fields, "table_" . $topic . "_" . $count;
} elsif ( $item->[0] =~ /^columns (.*)$/ ) {
push @fields, "table_" . $topic . "_" . $count;
} else {
push @fields, "info_" . $topic . "_" . $count;
}
}
}
return @fields;
}
=item $info->info_options( @topics );
Return the options of info for display.
All topics will be static picks.
All tables, and info items return only the
first banner. Call info_fields to get the
display of other lines.
=cut
sub info_options {
my ($self, @topics) = @_;
die "invalid method call" unless ref($self);
my %fields = ();
my $field = "";
my $index;
my $data;
foreach my $topic ( @topics ) {
$field = "topic_" . $topic;
$fields{$field} = [ $self->{topic}->[$topic-1] ];
$data = $self->data->{$topic-1};
foreach my $count ( 1 .. scalar @$data ) {
$index = $count - 1;
if ( $data->[$index]->[0] =~ /^rows (.*)$/ ) {
$field = "table_" . $topic . "_" . $count;
$fields{$field} = [ $1 ];
} elsif ( $data->[$index]->[0] =~ /^columns (.*)$/ ) {
$field = "table_" . $topic . "_" . $count;
$fields{$field} = [ $1 ];
} else {
$field = "info_" . $topic . "_" . $count;
$fields{$field} = [ $data->[$index]->[0] ];
}
# }
}
}
return \%fields;
}
=item $info->info_data( @topics );
Return the data of info for testing.
=cut
sub info_data {
my ($self, @topics) = @_;
die "invalid method call" unless ref($self);
my %fields = ();
my $field = "";
my $index;
my $data;
foreach my $topic ( @topics ) {
$field = "topic_" . $topic;
$fields{$field} = [ $self->{topic}->[$topic-1] ];
$data = $self->data->{$topic-1};
foreach my $count ( 1 .. scalar @$data ) {
$index = $count - 1;
if ( $data->[$index]->[0] =~ /^rows (.*)$/ ) {
$field = "table_" . $topic . "_" . $count;
$fields{$field} = $data->[$index];
$fields{$field}->[0] = $1;
} elsif ( $data->[$index]->[0] =~ /^columns (.*)$/ ) {
$field = "table_" . $topic . "_" . $count;
$fields{$field} = $data->[$index];
$fields{$field}->[0] = $1;
} else {
$field = "info_" . $topic . "_" . $count;
$fields{$field} = $data->[$index];
}
}
}
return \%fields;
}
=item $info->info_fields( $form, @topics );
Return the field info for for info selection.
=cut
sub info_fields {
my ($self, $form, @topics) = @_;
die "invalid method call" unless ref($self);
# predeclared for efficiency
my ($field, $index, $data, $comment, $item, $list, $max);
# Set each topic to static
foreach my $topic ( @topics ) {
$field = "topic_" . $topic;
$form->field( -name => $field, -type => 'static' );
$data = $self->data->{$topic-1};
# Add data to each selection as a comment
foreach my $count ( 1 .. scalar @$data ) {
$index = $count - 1;
if ( $data->[$index]->[0] =~ /^rows (.*)$/ ) {
$field = "table_" . $topic . "_" . $count;
$list = get_row_list( $data->[$index] );
$comment = "<p>" . table({-border => undef},
caption($1),
Tr({-align => 'CENTER', -valign => 'TOP'},
$list) );
$form->field( -name => $field, -comment => $comment );
} elsif ( $data->[$index]->[0] =~ /^columns (.*)$/ ) {
$field = "table_" . $topic . "_" . $count;
$list = get_col_list( $data->[$index] );
$comment = "<p>" . table({-border => undef},
caption($1),
Tr({-align => 'CENTER', -valign => 'TOP'},
$list) );
$form->field( -name => $field, -comment => $comment );
} else {
$field = "info_" . $topic . "_" . $count;
$comment = "<p><ul>";
foreach $item ( 1 .. $#{$data->[$index]} ) {
$comment .= "<li>" . $data->[$index]->[$item] . "</li>";
}
$comment .= "</ul></p>";
$form->field( -name => $field, -comment => $comment );
}
}
}
}
=item @fields = $info->fields( $form, \%label, @topics );
Return a list of topic and handout fields.
This will return only those info fields that
have been picked.
Returns labels for simple numbering of info items.
=cut
sub fields {
my ($self, $form, $labels, @topics) = @_;
die "invalid method call" unless ref($self);
my @fields = ();
my ($data, $item, $id, $info_count, $label);
my $topic_count = 1;
foreach my $topic ( @topics ) {
push @fields, $TOPIC[$topic_count];
$data = $self->data->{$topic-1};
$info_count = 1;
foreach my $count ( 1 .. scalar @$data ) {
$item = $data->[$count-1];
if ( $item->[0] =~ /^rows (.*)$/ ) {
$id = "table_" . $topic . "_" . $count;
} elsif ( $item->[0] =~ /^columns (.*)$/ ) {
$id = "table_" . $topic . "_" . $count;
} else {
$id = "info_" . $topic . "_" . $count;
}
if ( $form->field($id) ) {
$label = $TOPIC[$topic_count] . "_" . $info_count;
push @fields, $label;
$labels->{$label} = $info_count;
++ $info_count;
}
}
++ $topic_count;
}
return @fields;
}
=item $info->show_fields( $picks, $form, @topics );
Return the field info for a handout, in this
case all fields should be set to static. This
is based on form "picks" from "select_info".
=cut
sub show_fields {
my ($self, $picks, $form, @topics) = @_;
die "invalid method call" unless ref($self);
# predeclared for efficiency
my ($field, $index, $data, $comment, $item, $list, $max);
my ($info_count, $id);
my $topic_count = 1;
# Set each topic to static
foreach my $topic ( @topics ) {
$id = "topic_" . $topic;
$field = $TOPIC[$topic_count];
$form->field( -name => $field, -type => 'static' );
$data = $self->data->{$topic-1};
$info_count = 1;
# Add data to each selection as a comment, set to static
foreach my $count ( 1 .. scalar @$data ) {
$index = $count - 1;
$field = $TOPIC[$topic_count] . "_" . $info_count;
if ( $data->[$index]->[0] =~ /^rows (.*)$/ ) {
$id = "table_" . $topic . "_" . $count;
$list = get_row_list( $data->[$index] );
$comment = "<p>" . table({-border => undef},
caption($1),
Tr({-align => 'CENTER', -valign => 'TOP'},
$list) );
} elsif ( $data->[$index]->[0] =~ /^columns (.*)$/ ) {
$id = "table_" . $topic . "_" . $count;
$list = get_col_list( $data->[$index] );
$comment = "<p>" . table({-border => undef},
caption($1),
Tr({-align => 'CENTER', -valign => 'TOP'},
$list) );
} else {
$id = "info_" . $topic . "_" . $count;
$comment = "<p><ul>";
foreach $item ( 1 .. $#{$data->[$index]} ) {
$comment .= "<li>" . $data->[$index]->[$item] . "</li>";
}
$comment .= "</ul></p>";
}
if ( $picks->field($id) ) {
$form->field( -name => $field, -comment => $comment,
-type => 'static' );
++ $info_count;
}
}
++ $topic_count;
}
}
=item $info->show_options( $form, @topics );
Return the options of info for display.
All topic and info items will be static displays
for printing.
All tables, and info items return only the
first banner. Call show_fields to get the
display of other lines.
=cut
sub show_options {
my ($self, $form, @topics) = @_;
die "invalid method call" unless ref($self);
my %fields = ();
my $field = "";
my ($index, $data, $id, $info_count);
my $topic_count = 1;
foreach my $topic ( @topics ) {
$id = "topic_" . $topic;
$field = $TOPIC[$topic_count];
$fields{$field} = [ $self->{topic}->[$topic-1] ];
$data = $self->data->{$topic-1};
$info_count = 1;
foreach my $count ( 1 .. scalar @$data ) {
$index = $count - 1;
$field = $TOPIC[$topic_count] . "_" . $info_count;
if ( $data->[$index]->[0] =~ /^rows (.*)$/ ) {
$id = "table_" . $topic . "_" . $count;
$fields{$field} = [ $1 ] if $form->field($id);
} elsif ( $data->[$index]->[0] =~ /^columns (.*)$/ ) {
$id = "table_" . $topic . "_" . $count;
$fields{$field} = [ $1 ] if $form->field($id);
} else {
$id = "info_" . $topic . "_" . $count;
$fields{$field} = [ $data->[$index]->[0] ]
if $form->field($id);
}
++ $info_count if $form->field($id);
}
++ $topic_count;
}
return \%fields;
}
# $list = get_row_list( $data->[$index] );
# returns a list of rows in row order for display
sub get_row_list {
my ($list) = @_;
my @row_list = ();
my @header = @{$list->[1]};
my $max_header = scalar @header;
my ($count, $item);
# create rows with header items
foreach my $index ( 0 .. $max_header-1 ) {
push @row_list, [ "<b>" . $header[$index] . "</b>" ];
}
# find maximum list item
my $max = scalar @{$list->[2]};
foreach $item ( 3 .. scalar @$list - 1 ) {
$count = scalar @{$list->[$item]};
$max = $count if $count > $max;
}
# populate rows
$count = 0;
foreach $item ( 2 .. scalar @$list - 1 ) {
push @{$row_list[$count]}, @{$list->[$item]};
++ $count;
}
# create table rows
my $the_list = [];
foreach $item ( 0 .. $#row_list ) {
push @$the_list, td($row_list[$item]);
}
return $the_list;
}
# $list = get_col_list( $data->[$index] );
# returns a list of cols in col order for display
# th(['Vegetable', 'Breakfast','Lunch','Dinner']),
# td(['Tomatoes' , 'no', 'yes', 'yes']),
# td(['Broccoli' , 'no', 'no', 'yes']),
# td(['Onions' , 'yes','yes', 'yes'])
sub get_col_list {
my ($list) = @_;
my @col_list = ();
my @header = @{$list->[1]};
my $max_header = scalar @header;
my ($count, $item);
# find maximum list item
my $max = scalar @{$list->[2]};
foreach $item ( 3 .. scalar @$list - 1 ) {
$count = scalar @{$list->[$item]};
$max = $count if $count > $max;
}
# create cols
foreach my $index ( 0 .. $max_header-1 ) {
push @col_list, [ ];
}
# populate cols
$count = 0;
foreach $item ( 2 .. scalar @$list - 1 ) {
foreach $count ( 0 .. $max - 1 ) {
if ( $count < scalar @{$list->[$item]} ) {
push @{$col_list[$count]}, $list->[$item]->[$count];
} else {
push @{$col_list[$count]}, "";
}
}
}
# create table cols
my $the_list = [];
push @$the_list, th($list->[1]);
foreach $item ( 0 .. $#col_list ) {
push @$the_list, td($col_list[$item]);
}
return $the_list;
}
=item $output = $info->show( $form, $topics );
Return the handout screen of info for display.
Pass in the topic array and the current screen
response.
Information is numbered and indented at that
number level. Tables are just indented. So
the handout is in outline format.
=cut
sub show {
my ($self, $form, $topics) = @_;
die "invalid method call" unless ref($self);
my %fields = ();
my $field = "";
my $item;
my $data;
foreach my $topic ( @$topics ) {
$field = "topic_" . $topic;
$fields{$field} = [ $self->{topic}->[$topic-1] ];
$data = $self->data->{$topic-1};
foreach my $count ( 1 .. scalar @$data ) {
$item = $data->[$count-1];
if ( $item->[0] =~ /^rows (.*)$/ ) {
$field = "table_" . $topic . "_" . $count;
$fields{$field} = [ $1 ];
} elsif ( $item->[0] =~ /^columns (.*)$/ ) {
$field = "table_" . $topic . "_" . $count;
$fields{$field} = [ $1 ];
} else {
$field = "info_" . $topic . "_" . $count;
$fields{$field} = [ $item->[0] ];
}
}
}
return \%fields;
}
=item AUTOLOAD
Return or set any product info by default.
Put a new value for query of this product:
$product->query($query);
Return the query value for this product:
$product->query);
=cut
sub AUTOLOAD {
my $self = shift;
my $type = ref($self) or croak "$self is not an object";
my $name = $AUTOLOAD;
$name =~ s/.*://; # strip fully-qualified portion
croak "Can't access `$name' field in class $type"
unless (exists $self->{$name});
if (@_) {
return $self->{$name} = shift;
} else {
return $self->{$name};
}
}
# explicit destroy required because of AUTOLOAD
sub DESTROY {
}
1; # all packages must return 1 for sucessful loading
__END__
]]>