File Coverage

CGI/AppBuilder/Form.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package CGI::AppBuilder::Form;

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

our $VERSION = 0.10;
require Exporter;
our @ISA         = qw(Exporter CGI::AppBuilder);
our @EXPORT      = qw();
our @EXPORT_OK   = qw(disp_form replace_named_variables
    explode_variable explode_html
                   );
our %EXPORT_TAGS = (
    form => [qw(disp_form)],
    all  => [@EXPORT_OK]
);

=head1 NAME

CGI::AppBuilder::Form - Configuration initializer

=head1 SYNOPSIS

  use CGI::AppBuilder::Form;

  my $ab = CGI::AppBuilder::Form->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);
}

=head2 disp_form ($q, $ar)

Input variables:

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

Variables used or routines called:

  CGI::AppBuilder::Message
    echo_msg - echo messages
    set_param - get a parameter from hash array
  CGI::AppBuilder::Config
    eval_variables - replace value names with their values.

How to use:

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

Return: none

This method expects the following varialbes in $ar:

  gk - GUI key items
  gi - GUI items
  gc - GUI columns
  gf - GUI form
  db - database connection varialbes (optional)
  vars_keep - variables separated by comma for hidden variables
  hr_form - hash ref containing attributes for  such as
    -target = "main"

This method performs the following tasks:

  1) checks whether GI, GC and GF variables being defined.
  2) replaces AR, DB, GI, and GC variables with their contents
  3) builds GF elements
  4) add hidden variables
  5) print the form

=cut

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

    # check required GUI variables
    foreach my $k (split /,/, 'gi,gc,gf') {
        # $s->echo_msg("    checking $k...", 3);
        next if exists $ar->{$k};
        print h1("GUI element - {$k} is not defined");
        return;
    }
    if ($ar->{gi} =~ /db->/ && ! exists $ar->{db}) {
        print h1("GUI element - {db} is not defined");
        return;
    }
    my $mvs = {};
    $mvs = $s->eval_variables($ar->{gk}, $ar) if exists $ar->{gk};
    $mvs = $s->eval_variables($ar->{gi}, $ar) if exists $ar->{gi};
    $mvs = $s->eval_variables($ar->{gc}, $ar) if exists $ar->{gc};
    $mvs = $s->eval_variables($ar->{gf}, $ar) if exists $ar->{gf};

    my $db = (exists $ar->{db} && $ar->{db}) ? $ar->{db} : {};
    my $pr = {ar=>$ar, db=>$db};
    $s->replace_named_variables($ar, 'ar,db,gk,gi,gc','gk,gi,gc,gf');

    my $gk = $s->explode_variable($ar, 'gk', $pr);
    $pr->{gk} = $gk;
    my $gi = $s->explode_variable($ar, 'gi', $pr);
    $pr->{gi} = $gi;

    # my $gi = eval $ar->{gi};
    if ($gi !~ /HASH/) {
        $s->echo_msg($ar->{gi},2);
        $s->echo_msg("GI not properly defined." ,1);
    } else {
        $s->explode_html($gi, $pr);
    }
    # my $gc = eval $ar->{gc};
    my $gc = $s->explode_variable($ar, 'gc', $pr);
    $pr->{gc} = $gc;
    if ($gc !~ /HASH/ || ! exists $gc->{td}) {
        $s->echo_msg($ar->{gc},2);
        $s->echo_msg("GC not properly defined." ,1);
    } else {
        $s->echo_msg($ar->{gc},5);
        $s->echo_msg($gc,5);
    }
    $s->echo_msg($ar->{gf},5);
    # my $gf = eval $ar->{gf};
    my $gf = $s->explode_variable($ar, 'gf', $pr);

    my $fmn = 'fm1';
       $fmn = $ar->{form_name}
         if exists $ar->{form_name} && $ar->{form_name};
    print "\n";
    my %fr = (-name => $fmn, -method=>uc $ar->{method},
        -action=>"$ar->{action}?", -enctype=>$ar->{encoding} );
    if (exists $ar->{hr_form} && $ar->{hr_form}) {
        foreach my $k (keys %{$ar->{hr_form}}) {
            $fr{$k} = $ar->{hr_form}{$k};
        }
    }
    print start_form(%fr);
    my $hvs = $s->set_param('vars_keep', $ar);
    if ($hvs) {
        foreach my $k (split /,/, $hvs) {
            my $v = $s->set_param($k, $ar);
            next if $v =~ /^\s*$/;
            print hidden($k,$v);
        }
    }
    print "$gf\n";
    print end_form;
    print "\n";
    return;
}

=head2 explode_html ($gi, $pr)

Input variables:

  $gi   - a hash ref
  $pr   - a parameter hash ref

Variables used or routines called:

  CGI::AppBuilder::Message
    echo_msg - echo messages

How to use:

  my $ifn = 'myConfig.ini';
  my ($q,$ar) = $s->get_inputs($ifn);
  $self->explote_html($ar->{gi}, $ar);

Return: none

This method enables a 'x' command in your GUI definition and
processes the complex elements in the hash ref. For
instance, you have a GUI hash:

  gi = {   # GUI Items
    rts => ['rpt_src',['DataFax Generic','Study Specific'],
         'DataFax Generic'],
    xtd_rts => 'radio_group',
    act1 => td('Action'),
    act2 => td({-colspan=>'2',-align=>'center'},
          gk->{opf} . submit('a','Go') . ' ' . submit('a','Update') .
          ' ' . reset() ),
    xcp_act => 'act1,act2',
    act  => submit('a','Go') . ' ' . reset(),
    }

and the method will copy (xcp_act) the results (HTML text)
of $gi->{act1} and and $gi->{act2} into one. The $gi->{xcp_act}
will contains the combined string.

The 'xtd_' instructs the method to use $gi->{rts} as arguments for
the method name in $gi->{xtd_rts}.

=cut

sub explode_html {
    my $s = shift;
    my ($gi, $pr) = @_;

    my $ar = (exists $pr->{ar}) ? $pr->{ar} : {};
    my $gk = (exists $pr->{gk}) ? $pr->{gk} : {};
    my $gc = (exists $pr->{gc}) ? $pr->{gc} : {};
    my $db = (exists $pr->{db}) ? $pr->{db} : {};
    foreach my $k (keys %$gi) {
        next if ($k !~ /^x(td|cp)_(.+)/i);
        my ($k1, $k2) = ($1, $2);
        if ($k1 =~ /^td/i) {
            my $tmp_ar = [];
            if (ref($gi->{$k2}) =~ /ARRAY/) {
                $tmp_ar = $gi->{$k2};
            } else {
                $tmp_ar = eval $gi->{$k2};
            }
            if ($gi->{$k} =~ /^radio_group/i) {
                $gi->{$k} = radio_group(@$tmp_ar);
            } elsif ($gi->{$k} =~ /^popup_menu/i) {
                $gi->{$k} = popup_menu(@$tmp_ar);
            } else {
                $gi->{$k} = td(@$tmp_ar);
            }
        } else {
            my $txt = "";
            foreach my $i (split /,/, $gi->{$k}) {
                $txt .= $gi->{$i};
            }
            $gi->{$k} = $txt;
        }
    }
    $s->echo_msg($gi,5);
    return;
}

=head2 explode_variable ($xr, $i, $pr)

Input variables:

  $xr - a hash ref such as the elements of gi,gk,gc,gf in
        GUI hash array
  $i  - one of gi, gk, gc and gf
  $pr - a parameter hash ref containing the values for $i to be
        used in $xr

Variables used or routines called:

  CGI::AppBuilder::Message
    echo_msg - echo messages

How to use:

  my $ifn = 'myConfig.ini';
  my ($q,$ar) = $s->get_inputs($ifn);
  my $gi = $self->explode_variable($ar, 'gi', $ar);
  my $gc = $self->explode_variable($ar, 'gc', $ar);

Return: hash or hash ref for $i.

This method replaces variable names with their values and HTML
commands with their results.

=cut

sub explode_variable {
    my $s = shift;
    my ($xr, $i, $pr) = @_;
    my $hr = {};
    return wantarray ? %$hr : $hr if ! exists $xr->{$i};

    my $ar = (exists $pr->{ar}) ? $pr->{ar} : {};
    my $gi = (exists $pr->{gi}) ? $pr->{gi} : {};
    my $gk = (exists $pr->{gk}) ? $pr->{gk} : {};
    my $gc = (exists $pr->{gc}) ? $pr->{gc} : {};
    my $db = (exists $pr->{db}) ? $pr->{db} : {};
    if (ref($xr->{$i}) =~ /HASH/) {
        foreach my $k (keys %{$xr->{$i}}) {
            if (ref($xr->{$i}{$k}) =~ /^ARRAY/) {
                for my $j (0..$#{$xr->{$i}{$k}}) {
                    $hr->{$k}[$j] =
                    (ref($xr->{$i}{$k}[$j]) =~ /^(ARRAY|HASH)/) ?
                    $xr->{$i}{$k}[$j] : eval $xr->{$i}{$k}[$j];
                }
            } elsif (ref($xr->{$i}{$k}) =~ /^HASH/) {
                foreach my $j (keys %{$xr->{$i}{$k}}) {
                    $hr->{$k}{$j} =
                    (ref($xr->{$i}{$k}{$j}) =~ /^(ARRAY|HASH)/) ?
                     $xr->{$i}{$k}{$j} : eval $xr->{$i}{$k}{$j};
                }
            } else {
                $hr->{$k} = ($k =~ /^x(td|cp)/i) ? $xr->{$i}{$k} :
                    eval $xr->{$i}{$k};
            }
        }
    } else {
        $hr = eval $xr->{$i};
    }
    $s->echo_msg($hr,5);
    return wantarray ? %$hr : $hr;
}

=head2 replace_named_variables ($ar, $vs, $ks)

Input variables:

  $ar - a hash ref containing the elements of gi,gk,gc,gf in
        GUI hash array
  $vs - a list of variable names separated by comma such as
        'ar,db,gi,gk,gc'
  $ks - a list of key elements separated by comma such as
        'gk,gi,gc,gf'

Variables used or routines called:

  None

How to use:

  my $ifn = 'myConfig.ini';
  my ($q,$ar) = $s->get_inputs($ifn);
  $self->replace_named_variables($ar, 'ar,db,gk,gi,gc','gk,gi,gc,gf');

Return: None.

This method replaces named variables with their values in $ar.

=cut

sub replace_named_variables {
    my $s = shift;
    my ($ar, $vs, $ks) = @_;

    return if !$vs || !$ks;
    $vs =~ s/\s+//g; $ks =~ s/\s+//g;  # remove any blanks

    foreach my $v (split /,/, $vs) {     # variables: ar,db,gk,gi,gc
        foreach my $k (split /,/, $ks) { # keys: gk,gi,gc,gf
            next if ! exists $ar->{$k};
            $ar->{$k} =~ s/$v\->/\$$v->/g if ref($ar->{$k}) !~ /^HASH/;
            next                          if ref($ar->{$k}) !~ /^HASH/;
            foreach my $i (keys %{$ar->{$k}}) {
                if (ref($ar->{$k}{$i}) !~ /^(ARRAY|HASH)/) {
                    $ar->{$k}{$i} =~ s/$v\->/\$$v->/g;
                    next;
                }
                if (ref($ar->{$k}{$i}) =~ /^ARRAY/) {
                    for my $j (0..$#{$ar->{$k}{$i}}) {
                        $ar->{$k}{$i}[$j] =~ s/$v\->/\$$v->/g;
                    }
                } else {
                    for my $j (keys %{$ar->{$k}{$i}}) {
                        $ar->{$k}{$i}{$j} =~ s/$v\->/\$$v->/g;
                    }
                }
            }
        }
    }
    return;
}

1;

=head1 HISTORY

=over 4

=item * Version 0.10

This version extracts the disp_form method from CGI::Getopt class,
inherits the new constructor from CGI::AppBuilder, and adds
new methods of replace_named_variables, explode_variable, and
explode_html.

=item * Version 0.20

=cut

=head1 SEE ALSO (some of docs that I check often)

Oracle::Loader, Oracle::Trigger, CGI::Getopt, File::Xcopy,
CGI::AppBuilder, CGI::AppBuilder::Message, CGI::AppBuilder::Log,
CGI::AppBuilder::Config, etc.

=head1 AUTHOR

Copyright (c) 2005 Hanming Tu.  All rights reserved.

This package is free software and is provided "as is" without express
or implied warranty.  It may be used, redistributed and/or modified
under the terms of the Perl Artistic License (see
http://www.perl.com/perl/misc/Artistic.html)

=cut