CGI::AppBuilder - CGI Application Builder

  use CGI::AppBuilder;

  my $cg = CGI::AppBuilder->new('ifn', 'my_init.cfg', 'opt', 'vhS:a:');
  my $ar = $cg->get_inputs; 

  $ifn  - input/initial file name. 
  $opt  - options for Getopt::Std

  None

   my $ca = new CGI::AppBuilder;      # or
   my $ca = CGI::AppBuilder->new;     # or
   my $ca = CGI::AppBuilder->new(ifn=>'file.cfg',opt=>'hvS:'); # or
   my $ca = CGI::AppBuilder->new('ifn', 'file.cfg','opt','hvS:'); 

  $self->{ifn} = ""
  $self->{opt} = 'hvS:'; 

  $prg  - program name 
  $arg  - array ref for arguments - %ARGV
  $nhh  - no html header pre-printed 
          1 - no HTML header is set in any circumstance
          0 - HTML header will be set when it is possible

  build_html_header - build HTML header array
  Debug::EchoMessage
    echo_msg  - echo messages
    start_log - start and write message log
  CGI::Getopt
    get_inputs - read input file and/or CGI form inputs

   my ($q, $ar, $ar_log) = $self->start_app($0,\@ARGV);

  $q - a CGI object
  $ar - hash ref containing parameters from input file and/or 
        CGI form inputs and the following elements:
    ifn - initial file name
    opt - command input options
    cfg - configuratoin array
    html_header - HTML header parameters (hash ref)
    msg - contain message hash
  $ar_log - hash ref containing log information

  1) initial a CGI object
  2) read initial file if specified or search for a default file
     (the same as $prg with .ini extension) and save the file name
     to $ar->{ifn}. 
  3) define message level
  4) start HTML header and body using I<page_title> and I<page_style>
     if they are defined.
  5) parse CGI form inputs and combine them with parameters defined
     in initial file
  6) read configuration file ($prg.cfg) if it exists and save the 
     array to $ar->{cfg}
  7) prepare log record if write log is enabled

  $q    - CGI object 
  $ar   - array ref for parameters 
  $ar_log - hash ref for log record
  $nhh  - no html header pre-printed 
          1 - no HTML is printed in any circumstance
          0 - HTML header will be printed when it is possible

  Debug::EchoMessage
    echo_msg - echo messages
    end_log - start and write message log
    set_param - get a parameter from hash array

   my ($q, $ar, $ar_log) = $self->start_app($0,\@ARGV);
   $self->end_app($q, $ar, $ar_log);

  1) ends HTML document 
  2) writes log records to log files 
  3) close database connection if it finds DB handler in {dbh}

package CGI::AppBuilder;

# Perl standard modules
use strict;
use warnings;
use Getopt::Std;
use POSIX qw(strftime);
use CGI;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
use CGI::Pretty ':standard';
use CGI::AppBuilder::Config   qw(:all); 
use CGI::AppBuilder::Message  qw(:all); 
use CGI::AppBuilder::Log      qw(:all); 
use CGI::AppBuilder::Form     qw(:all); 
use CGI::AppBuilder::Table    qw(:all); 
use CGI::AppBuilder::Header   qw(:all); 
use CGI::AppBuilder::Frame    qw(:all); 

our $VERSION = 0.12;
warningsToBrowser(1);

require Exporter;
our @ISA         = qw(Exporter);
our @EXPORT      = qw(start_app end_app);
our @IMPORT_OK = (@CGI::AppBuilder::Config::EXPORT_OK,
    @CGI::AppBuilder::Message::EXPORT_OK, 
    @CGI::AppBuilder::Log::EXPORT_OK, 
    @CGI::AppBuilder::Form::EXPORT_OK, 
    @CGI::AppBuilder::Table::EXPORT_OK, 
    @CGI::AppBuilder::Header::EXPORT_OK, 
    @CGI::AppBuilder::Frame::EXPORT_OK 
);
our @EXPORT_OK   = (qw(start_app end_app),@IMPORT_OK);
our %EXPORT_TAGS = (
    app      => [qw(start_app end_app build_html_header)],
    config   => [@CGI::AppBuilder::Config::EXPORT_OK],
    echo_msg => [@CGI::AppBuilder::Message::EXPORT_OK],
    log      => [@CGI::AppBuilder::Log::EXPORT_OK],
    form     => [@CGI::AppBuilder::Form::EXPORT_OK],
    table    => [@CGI::AppBuilder::Table::EXPORT_OK],
    header   => [@CGI::AppBuilder::Header::EXPORT_OK],
    frame    => [@CGI::AppBuilder::Frame::EXPORT_OK],
    all      => [@EXPORT_OK, @IMPORT_OK]
);

sub new {
    my $caller        = shift;
    my $caller_is_obj = ref($caller);
    my $class         = $caller_is_obj || $caller;
    my $self          = bless {}, $class;
    my %arg           = @_;   # convert rest of inputs into hash array
    foreach my $k ( keys %arg ) {
        if ($caller_is_obj) {
            $self->{$k} = $caller->{$k};
        } else {
            $self->{$k} = $arg{$k};
        }
    }
    $self->{ifn} = ""     if ! exists $arg{ifn};
    $self->{opt} = 'hvS:' if ! exists $arg{opt};
    return $self;
}

sub start_app {
    my $s = shift;
    my ($prg, $ar_arg, $nhh) = @_;
    my $args = ($ar_arg && $ar_arg =~ /ARRAY/)?(join " ", @$ar_arg):'';
    my $ifn = $prg; $ifn =~ s/\.(\w+)$/\.ini/;
    my $cfg = $prg; $cfg =~ s/\.(\w+)$/\.cfg/;
    my $opt  = 'a:v:hS:';
    my ($q, $ar);
    # 0. need to decide it is in verbose mode or not
    my $web_flag = 0; 
    if (exists $ENV{HTTP_HOST} || exists $ENV{QUERY_STRING}) {
        $q = CGI->new;
	my $v1 = $q->param('v');
	my $v2 = $q->Vars->{v}; 
	if ((defined($v1) && $v1) || (defined($v2) && $v2)) { 
	    $web_flag = 1;
            print $q->header("text/html") if !$nhh; 
	}
    }
    #
    # 1-3,5. Read initial file
    ($q,$ar) = $s->get_inputs($ifn,$opt);
    $s->echo_msg(" += Starting application...");
    $s->echo_msg(" ++ Reading initial file $ifn...")    if  -f $ifn;
    $s->echo_msg(" +  Initial file - $ifn: not found.") if !-f $ifn;
    # if user has defined messages in the initial file, we need to 
    # convert it into hash.
    $ar->{msg} = eval $ar->{msg} if exists $ar->{msg}; 

    # 4. start HTML header
    my %ar_hdr = $s->build_html_header($q, $ar); 
    $ar->{html_header} = \%ar_hdr   if ! exists $ar->{html_header}; 

    # 5. start the HTML page
    if (!$nhh && (
        exists $ENV{HTTP_HOST} || exists $ENV{QUERY_STRING})) { 
        print $q->header("text/html") if ! $web_flag;
	print $q->start_html(%ar_hdr), "\n";
        print $ar->{top_nav} if exists $ar->{top_nav} && $ar->{top_nav};
    }

    # 6. read configuration file
    if (-f $cfg) { 
        $s->echo_msg(" ++ Reading config file $cfg...");
        $ar->{cfg} = $s->read_cfg_file($cfg); 
    }

    # 7. set log array
    my ($ds,$log_dir,$log_brf, $log_dtl) = ('/',"","","");
       $log_dir = (exists ${$ar}{log_dir})?${$ar}{log_dir}:'.';
    my $lgf = $ifn; $lgf =~ s/\.\w+//; $lgf =~ s/.*[\/\\](\w+)$/$1/;
    my $tmp = strftime "%Y%m%d", localtime time;
       $log_brf = join $ds, $log_dir, "${lgf}_brief.log";
       $log_dtl = join $ds, $log_dir, "${lgf}_${tmp}.log";
    my ($lfh_brf,$lfh_dtl,$txt,$ar_log) = ("","","","");
    if (exists ${$ar}{write_log} && ${$ar}{write_log}) {
        $ar_log = $s->start_log($log_dtl,$log_brf,"",$args,2);
    }
    $s->echo_msg($ar,5);
    $s->echo_msg($ar_log,5);
    return ($q,$ar,$ar_log);
}

sub end_app {
    my $s = shift;
    my ($q, $ar, $ar_log, $nhh) = @_;
    if (exists ${$ar}{write_log} && ${$ar}{write_log}) {
        $s->end_log($ar_log);
    }
    my $dbh = $s->set_param('dbh', $ar);
    $dbh->disconnect() if $dbh; 
    if (exists $ENV{HTTP_HOST} || exists $ENV{QUERY_STRING}) { 
        print $ar->{bottom_nav} if exists $ar->{bottom_nav} && !$nhh; 
        print $q->end_html   if !$nhh;
    }
}

1;