#!/usr/bin/perl -w
#
=pod

=head1 OptParamRpt.pm

A subclass of I<SqlHtmlRpt.pm> which allows use of C<sqlon> parameters,
which are meant to enhance C<sqlpn> parameters in a safe manner.

=head2 Copyright

=over 4

=item Author

Fred Morris

=item version

2.8

=item Creation Date

06-Jun-2005 from SqlHtmlRpt.pm

=item Modification History



=item Copyright

Copyright (c) 2002-2005 by Fred Morris, 6739 3rd NW Seattle WA USA 98117
e-mail: m3047 (funny sign) inwa-dot-net telephone 206.297.6344

Licensed under the same terms as Perl itself, with no warranty or claims of fitness
for any particular use.

=back

=head2 Properties

There are no additional properties beyond those declared by I<SqlHtmlRpt>.

=head2 Subclassed and Private Methods

=head3 fmt_param( field_hash, init )

Overridden to define the fmt_param_o parameter type.

=head3 fmt_param_o( param_value, substututions, index )

Implements the extension which is provided by this subclass. Returns the
I<substitutions> in the passed arrayref. I<index> is the number of the
parameter, the C<N> in C<sqloN>.

=head2 Public Methods

This module overrides or alters the operation of the following methods.

=head3 format( sql_mode, template, init )

See I<SqlHtmlRpt> for the basic concepts of operation. Performs additional
preprocessing on C<sqloN> parameters, as they might be used in the context
of a HTML C<SELECT> item, and renders them "safe"... along with some
additional, useful cruft, of course.

=head2 CGI Parameters

CGI parameters are the same as for I<SqlHtmlRpt> with the addition of
C<sqloN> parameters.

=head2 Template Extensions

This module introduces an additional template construct, the C<SQLON>
comment block (and additional optional C<SQLON_X> blocks). The C<SQLON>
block is B<required> for each C<sqlon> parameter.

The purpose of these blocks is to define the allowable values for the
C<sqlon> parameter and map those to substitution values. The substitutions
are performed before the template is deconstructed, so you can use
C<%%sqlxn%%> substitutions within them.

Within each block, on a separate line, each allowable value is mapped to
a substitution string as follows:

<value> C<= "><substitution>C<">

=head3 additional substitution values

The original C<%%sqloN%%> value is still available for substitution.

In addition, the following substitutions are available:

=over 4

=item C<%%sql_opt_N%%>

The mapped substitution for the corresponding C<SQLPN> block will be
inserted here.

=item C<%%sql_opt_N_X%%>

Any values for additional C<SQLPN_X> blocks will be inserted.

=back

When the I<init> CGI parameter is true, these additional substitutions are
replaced with an empty string.

=head2 Usage Notes

The C<sqlpN> parameter variant (as opposed to the C<sqlsN> and C<sqlnN>
variants) is generally recognized (and documented) as unsafe unless additional
checking is done in the enclosing CGI.

Not that there aren't ways around this:
you may find a file called C<rpt-safe-sqlpn-hack.tmpl> in this directory which
shows one way of rendering C<sqlpN> parameters relatively safe without coding
it in the CGI wrapper. But it is a hack; sort of a fun hack, but nonetheless
a hack, and not particularly extensible.

If you don't trust the people creating the templates, then coding in the CGI
wrapper is still the best answer.

If you do trust the people creating the templates (just not the (ab)users using
them), then this extension is one possible answer. In particular, if you want
to do wholesale alterations to the SQL statements which are executed based on
some known set of possible values, this is a pretty elegant solution.

In addition to the previously mentioned file, you should find a file named
C<rpo-contact-field-sort.tmpl> which accomplishes the same thing as
C<rpt-safe-sqlpn-hack.tmpl> but utilizing the extensions in this module.

=head2 A Message From Our Sponsor

Want help? Fred Morris has been a licensed business in Seattle Washington since
1984. I have extensive experience writing and using reporting tools. I helped write
Park Software's I<XENTIS> report writer for I<OpenVMS> (and the mother of I<all> report
wizards), working on its development off and on
for about 8 years. Not only have I used XENTIS in production environments, I have
extensive experience with a variety of SQL (and other) databases as well as with
ACI's I<4th Dimension> and Microsoft's I<Access>.

We can provide training, consulting and even do it all for you: contact us!

=cut

use strict;

package OptParamRpt;

# Yes, we are 5.5.3 compatible; thanks for asking!
use vars qw/ @ISA /;
use SqlHtmlRpt;
@ISA = ( 'SqlHtmlRpt' );

use DBI;
use CGI;

# -=-=-=- SUBCLASSED METHODS -=-=-=-

# CGI parameter processing wrapper.
sub fmt_param( $$$ ) {

    my $self = shift;
    my $fields = shift;
    my $init = shift;

    my $cgi = $self->{cgi};

    my $i;

    # When init is true, replace the optional sql_opt_n_x substitutions
    # with empty strings before bailing out.

    if ($init) {

        $self->{template} =~ s/%%sql_opt_\d+(?:_\d+)%%//giso;

        return undef;
    }

    for ( $i = 1; 1; $i++ ) {

        my $pv;
        my $p;

        if      ( defined($pv = $cgi->param( $p = "sqln$i" )) ) {

            (defined($pv = $self->fmt_param_n( $pv )))
                or return "$p (a query parameter) $self->{errstr}";
        }
        elsif   ( defined($pv = $cgi->param( $p = "sqls$i" )) ) {

            (defined($pv = $self->fmt_param_s( $pv )))
                or return "$p (a query parameter) $self->{errstr}";
        }
        elsif   ( defined($pv = $cgi->param( $p = "sqlp$i" )) ) {

            (defined($pv = $self->fmt_param_p( $pv )))
                or return "$p (a query parameter) $self->{errstr}";
        }
        # THIS IS WHAT WE ARE DOING, WHAT IT IS ALL ABOUT
        elsif   ( defined($pv = $cgi->param( $p = "sqlo$i" )) ) {

            my @substitutions;

            (defined($pv = $self->fmt_param_o( $pv, \@substitutions, $i )))
                or return "$p (a query parameter) $self->{errstr}";

            # Go through all of the option block substitutions and do them
            # now.

            my $template = $self->{template};

            my $j;
            my $kv;
            my $fv;

            for( $j = 0; $j < @substitutions; $j++ ) {

                $kv = ($j == 0) ? "sql_opt_$i" : "sql_opt_$i" . "_$j";
                $fv = $substitutions[$j];

                $template =~ s/%%$kv%%/$fv/gis;
            }

            $self->{template} = $template;
        }
        else {

            last;
        }

        # Make sure that it doesn't have a bare quote in it.

        if ($pv =~ m/"/sio) {       # " is bad in HTML value attributes

            return "I'm sorry but I can't allow you to put a '&quot;' in $p";
        }

        # Add it to our fields.

        $fields->{$p} = $pv;
    }

    # All done.

    return undef;

} # &fmt_param

# Option parameter
sub fmt_param_o( $$$$ ) {

    my $self = shift;
    my $pv = shift;
    my $substitutions = shift;
    my $i = shift;

    my $s;

    my $matchspec = 'SQLO' . $i;

    if ( $self->{template} =~ s/<!--$matchspec\s+(.+?)-->//s ) {

        $s = $1;
        my %sqlo;

        # Get the base block.

        (%sqlo = $s =~ m/(\w+)\s*=\s*"(.*?)"/gso)
                or return $self->bad_undef( "has an empty SQLO$i spec" );

        # Validate the parameter.

        (exists $sqlo{$pv})
                or return $self->bad_undef( "has an invalid value $pv for SQLO$i" );

        push @{$substitutions}, $sqlo{$pv};

        # Here we look for additional substitutions.

        my $j;

        for ( $j = 1;
              $matchspec = 'SQLO' . $i . '_' . $j,
              $self->{template} =~ s/<!--$matchspec\s+(.+?)-->//s;
              $j++ ) {

            $s = $1;

            my %subs;

            (%subs = $s =~ m/(\w+)\s*=\s*"(.*?)"/gso)
                or return $self->bad_undef( "has an empty SQLO$i" . "_$j spec" );

            (exists $subs{$pv})
                or return $self->bad_undef( "has an invalid value $pv for SQLO$i" . "_$j" );

            push @{$substitutions}, $subs{$pv};

        }
    }
    else {

        return $self->bad_undef( "SQLO$i block not found" );
    }

    # All done.

    return $pv;

} # &fmt_param_o

1;