File Coverage

CGI/AppBuilder/Header.pm

Criterion	Covered	Total	%
statement	16	18	88.8
branch			n/a
condition			n/a
subroutine	6	6	100.0
pod			n/a
total	22	24	91.6

package CGI::AppBuilder::Header;

# Perl standard modules
use strict;
use warnings;
use Getopt::Std;
use POSIX qw(strftime);
use Carp;
use CGI::AppBuilder;
use CGI::AppBuilder::Message qw(:echo_msg);

our $VERSION = 0.12;
require Exporter;
our @ISA         = qw(Exporter CGI::AppBuilder);
our @EXPORT      = qw();
our @EXPORT_OK   = qw(build_html_header
                   );
our %EXPORT_TAGS = (
    all  => [@EXPORT_OK]
);

=head1 NAME

CGI::AppBuilder::Header - Configuration initializer

=head1 SYNOPSIS

  use CGI::AppBuilder::Header;

  my $ab = CGI::AppBuilder::Header->new(
     'ifn', 'my_init.cfg', 'opt', 'vhS:a:');
  my ($q, $ar, $ar_log) = $ab->start_app($0, \%ARGV);
  print $ab->disp_form($q, $ar);

=head1 DESCRIPTION

This class provides methods for reading and parsing configuration
files.

=cut

=head2 new (ifn => 'file.cfg', opt => 'hvS:')

This is a inherited method from CGI::AppBuilder. See the same method
in CGI::AppBuilder for more details.

=cut

sub new {
  my ($s, %args) = @_;
  return $s->SUPER::new(%args);
}

=head3 build_html_header ($q, $ar)

Input variables:

  $q    - CGI object
  $ar   - array ref for parameters

Variables used or routines called:

  Debug::EchoMessage
    echo_msg - echo messages
    set_param - get a parameter from hash array

How to use:

  my $ifn = 'myConfig.ini';
  my ($q,$ar) = $s->get_inputs($ifn);
  my $hrf = $self->build_html_header($q, $ar);

Return: hash array or array ref

This method performs the following tasks:

  1) check the following parameters: page_title, page_style,
     page_meta, page_author, page_target, js_src,
  2) writes log records to log files
  3) close database connection if it finds DB handler in {dbh}

=cut

sub build_html_header {
    my $s = shift;
    my ($q, $ar) = @_;

    # 4. start HTML header
    my $title = $s->set_param('page_title', $ar);
       $title = "Untitled Page"            if ! $title;
    my $style = $s->set_param('page_style', $ar);
       $style = ''                 if ! $style;
    my $author = $s->set_param('page_author', $ar);
       $author = '[e-mail]' if ! $author;
    my $target = $s->set_param('page_target', $ar);
       # $target = '_blank'                  if ! $target;
    my $js_src = $s->set_param('js_src', $ar);
    my $yr = strftime "%Y", localtime time;
    my $meta_txt = $s->set_param('page_meta', $ar);
    my $mrf = {};
    if ($meta_txt) {
       $mrf = eval $meta_txt;
       $mrf->{'keywords'} = 'Perl Modules';
       $mrf->{'copyright'}= "copyright $yr Hanming Tu";
    } else {
       $mrf = {'keywords'=>'Perl Modules',
         'copyright'=>"copyright $yr Hanming Tu"};
    }
    my %ar_hdr = (-title=>$title, -author=>$author, -meta=>$mrf);
    $ar_hdr{-target}= $target    if $target;
    $ar_hdr{-style} = ($style =~ /^