WWW::Mooos::Scraper::Validate - WWW::Mooos::Scraper input validate module

WWW-Mooos-Scraper documentation Contained in the WWW-Mooos-Scraper distribution.

Index

Code Index:

NAME

Top

WWW::Mooos::Scraper::Validate - WWW::Mooos::Scraper input validate module

VERSION

Top

0.01

DESCRIPTION

Top

WWW::Mooos::Scraper input validate module

VALIDATE METHOD

Top

Defined in %WWW::Mooos::Scraper::Validate::VALIDATE_METHOD

length

Length check

Example:

  # in WWW::Mooos::Scraper::Validate::validate_map
  param1 => [ [ "length", 30] ], # max 30
  param2 => [ [ "length", 0, 30] ], # between 0 and 30

regex

Regex check

Example:

  param1 => [ [ "regex", qr/^foo$/ ] ],

require

Require check

Example:

  param1 => [ "require" ],

skip

When check value is undef, other checks are not done

Example:

  # when param1 is not undef, length and regex check done
  param1 => [ "skip", [ "length", 30 ], [ "regex", qr/bar/ ]  ],

url

URL regex check

Example:

  param1 => [ "url" ],

METHOD

Top

new

Create instance

Example: 

  my $valid = WWW::Mooos::Scraper::Validate->new( mooos => $mooos );

validate

input validate

Example:

  my($p, $e) = $valid->validate(%param);
  if(keys %{$e}){
    # error trap
  }

ACCESSOR METHOD

Top

mooos

Get WWW::Mooos::Scraper instance

Example:

  $mooos = $self->mooos;

ABSTRACT METHOD

Top

validate_map

validate_message

1;

__END__

SEE ALSO

Top

Class::Accessor Readonly Sub::Install

AUTHOR

Top

Akira Horimoto

COPYRIGHT AND LICENSE

Top

This library is free software. You can redistribute it and/or modify it under the same terms as perl itself.

Copyright (C) 2007 Akira Horimoto

WWW-Mooos-Scraper documentation Contained in the WWW-Mooos-Scraper distribution. 
package WWW::Mooos::Scraper::Validate;


use strict;
use warnings;
use base qw(Class::Accessor);
use Carp;
use Readonly;
use Sub::Install;

__PACKAGE__->mk_ro_accessors(qw(mooos));

our $VERSION = 0.01;


Readonly my %VALIDATE_METHOD => (

    "length"  => sub {
                    my($self, $val, $args) = @_;
                    my($min, $max, $flag);
                    my $length = length $val;
                    if(scalar @{$args} == 2){
                        ($min, $max) = @{$args};
                        $flag = ($length <= $max && $length > $min) ? 1 : 0;
                    }else{
                        $max = $args->[0];
                        $flag = ($length <= $max) ? 1 : 0;
                    }
                    return $flag;
                },

    "regex"   => sub {
                    my($self, $val, $args) = @_;
                    return ($val =~ $args->[0]) ? 1 : 0;
                },

    "require" => sub {
                    my($self, $val) = @_;
                    return ($val ne "") ? 1 : 0;
                },
    "skip"    => sub { "skip" },

    "url"     => sub {
                    my($self, $val) = @_;
                    return ($val =~ /^s?https?:\/\/[-_.!~*'()a-zA-Z0-9;\/?:\@&=+\$,%#]+$/) ? 1 : 0;
                },
);


sub import {

    my $class = shift;
    map { 
        Sub::Install::install_sub({ 
                code => sub { croak("$_ is abstract method") },
                as   => $_
            })
    } qw(validate_map validate_message);
}


sub new {

    my($class, %args) = @_;
    if(ref($args{mooos}) ne "WWW::Mooos::Scraper"){
        croak("args.mooos is not WWW::Mooos::Scraper instance");
    }
    return bless { mooos => $args{mooos} }, $class || ref $class;
}


sub validate {

    my($self, %param) = @_;
    my(%error, %check);

    my $validate_map     = $self->validate_map;
    my $validate_message = $self->validate_message;

    LOOP_VALIDATE_MAP:
    foreach my $key(keys %{$validate_map}){

        my $meths = $validate_map->{$key};
        LOOP_VALIDATE_METHOD:
        foreach my $m(@{$meths}){

            my $unless = 0;
            my $val    = "";
            my($meth, $meth_args);
            if(ref($m) eq "ARRAY"){
                $meth      = shift @{$m};
                $meth_args = $m;
            }else{
                $meth      = $m;
            }

            if($meth =~ /^\!(.+)$/){
                $unless = 1;
                $meth   = $1;
            }

            $val = $param{$key} if exists $param{$key};
            last if $meth eq "skip" && $val eq "";

            my $answer = $VALIDATE_METHOD{$meth}->($self, $val, $meth_args);

            if(!$answer && !$unless){
                
                $check{$key} = $validate_message->{$key}->{$meth};
                last;
            }

        } # end of LOOP_VALIDATE_METHOD:

    } # end of LOOP_VALIDATE_MAP:

    if(keys %check){

        %error = (
                error => "input data error",
                param => \%check
            );
    }
    return \%param, \%error;
}