Maypole::Plugin::AutoUntaint - CDBI::AutoUntaint for Maypole

Maypole-Plugin-AutoUntaint documentation Contained in the Maypole-Plugin-AutoUntaint distribution.

Index

Code Index:

NAME

Top

Maypole::Plugin::AutoUntaint - CDBI::AutoUntaint for Maypole

SYNOPSIS

Top

    package BeerDB;
    use Maypole::Application qw( AutoUntaint );

    # instead of this
    #BeerDB::Brewery->untaint_columns( printable => [qw/name notes url/] );
    #BeerDB::Style->  untaint_columns( printable => [qw/name notes/] );
    #BeerDB::Pub->    untaint_columns( printable => {qw/name notes url/] );
    #BeerDB::Beer->   untaint_columns( printable => [qw/abv name price notes/],
    #                                  integer    => [qw/style brewery score/],
    #                                  date       => [ qw/date/],
    #                                  );   

    # say this
    BeerDB->auto_untaint;
setup

Installs the Class::DBI::Plugin::AutoUntaint::auto_untaint() method into the model class.

auto_untaint( %args )

Takes the same arguments as Class::DBI::AutoUntaint::auto_untaint(), but untaint_columns and skip_columns must be further keyed by table:

untaint_columns
    untaint_columns => { $table => { printable => [ qw( name title ) ],
                                     date => [ qw( birthday ) ],
                                     },
                         ...,
                         },
skip_columns
    skip_columns => { $table => [ qw( secret_stuff internal_data )  ],
                      ...,
                      },

Accepts two additional arguments. match_cols_by_table is the same as the match_cols argument, but only applies to specific tables:

match_cols_by_table
    match_cols_by_table => { $table => { qr(^(first|last)_name$) => 'printable',
                                         qr(^.+_event$)          => 'date',
                                         qr(^count_.+$)          => 'integer',
                                         },
                             ...,
                             },

Column regexes here take precedence over any in <match_cols> that are the same.

untaint_tables

Specifies the tables to untaint as an arrayref. Defaults to <$r-config->{display_tables}>>.

debug

The debug level of the Maypole application is passed on to Class::DBI::Plugin::AutoUntaint. If set to 1, this notes (via warn) each table processed.

If the debug level is set to 2, it will report the untaint type used for each column.

If debug mode is turned off, this module switches on Class::DBI::Plugin::AutoUntaint's 'strict' mode.

TODO

Top

Tests!

SEE ALSO

Top

This module wraps Class::DBI::Plugin::AutoUntaint, which describes the arguments in more detail.

Maypole::Plugin::Untaint.

AUTHOR

Top

David Baird, <cpan@riverside-cms.co.uk>

BUGS

Top

Please report any bugs or feature requests to bug-maypole-plugin-autountaint@rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Maypole-Plugin-AutoUntaint. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

COPYRIGHT & LICENSE

Top

Copyright 2005 David Baird, All Rights Reserved.

Maypole-Plugin-AutoUntaint documentation Contained in the Maypole-Plugin-AutoUntaint distribution. 
package Maypole::Plugin::AutoUntaint;

use UNIVERSAL::require;

use warnings;
use strict;

use NEXT;

Class::DBI::Plugin::AutoUntaint->require;


our $VERSION = 0.07;


sub setup 
{
    my $r = shift;
    
    # ensure Maypole::setup() is called, which will load the model class
    $r->NEXT::DISTINCT::setup( @_ );

    # insert CDBI::Plugin::AutoUntaint and CDBI::Plugin::Type into the model class
    my $model = $r->config->model ||
        die "Please configure a model in $r before calling auto_untaint()";
    
    no strict 'refs';
    *{"$model\::auto_untaint"} = \&Class::DBI::Plugin::AutoUntaint::auto_untaint;
    
    eval "package $model; use Class::DBI::Plugin::Type";
    
    die $@ if $@;
}


sub auto_untaint {
    my ( $r, %args ) = @_;
    
    my $untaint_tables = $args{untaint_tables} || $r->config->{display_tables};

    foreach my $table ( @$untaint_tables )
    {
        my %targs = map { $_ => $args{ $_ } } qw( untaint_types match_types );
        
        $targs{untaint_columns} = $args{untaint_columns}->{ $table };
        $targs{skip_columns}    = $args{skip_columns}->{ $table };
        
        $targs{match_columns} = $args{match_columns};
        
        if ( my $more_match_cols = $args{match_columns_by_table}->{ $table } )
        {
            $targs{match_columns}->{ $_ } = $more_match_cols->{ $_ } 
                for keys %$more_match_cols;
        }
                                    
        $targs{debug} = $r->debug;
        
        $targs{strict} = 1 unless $r->debug;
        
        my $class = $r->config->loader->find_class( $table );
        
        die "no class exists for table '$table'" unless $class;
    
        $class->auto_untaint( %targs );
    }
}


1; # End of Maypole::Plugin::AutoUntaint