Changeset 320

Show
Ignore:
Timestamp:
10/25/06 18:04:09 (2 years ago)
Author:
miya
Message:

copy //mirror/perl to //local/perl
HTML::Widget::Kwalify: added tests.
tiny refactoring.
redefine HTML::Element::_xml_escape for avoiding multibyte characters corrupting.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • library/perl/trunk/HTML-Widget-Kwalify

    • Property svn:ignore set to blib

  • library/perl/trunk/HTML-Widget-Kwalify/lib/HTML/Widget/Kwalify.pm

    r319 r320  
    88 
    99use base qw( HTML::Widget ); 
    10 use YAML qw( LoadFile Dump DumpFile ); 
     10use YAML qw( LoadFile DumpFile Load Dump ); 
    1111use UNIVERSAL; 
    1212use CGI::Expand; 
    …… 
    1818 
    1919    unless ( ref $yaml ) { 
    20         $yaml = LoadFile($yaml); 
     20        eval { $yaml = Load($yaml); }; 
     21        $yaml = LoadFile($yaml) if $@; 
    2122    } 
    2223 
    …… 
    5657                !$class ? 
    5758                    do { 
    58                         if ( grep { $arg eq $_ } ( qw/ str int any / ) ) { 
     59                        if ( grep { $arg eq $_ } ( qw/ str int any date / ) ) { 
    5960                            $element->type($arg); 
    6061                            push @elements, $element; 
    …… 
    7071 
    7172                            push @{ $clone->stack }, $key 
    72                                 unless ( grep { $key eq $_ } ( qw/ mapping sequence desc name / ) ); 
     73                                if ( isa($arg->{$key}, 'HASH') and defined $arg->{$key}->{type}); 
    7374 
    7475                            if ( $key eq 'sequence' ) { 
    …… 
    8081                            if ( $key eq 'type' ) { 
    8182                                push @{ $clone->enum },  @{ $arg->{enum} } if $arg->{enum}; 
    82                                 $clone->name($arg->{name}) if $arg->{name}; 
    83                                 $clone->desc($arg->{desc}) if $arg->{desc}; 
     83                                for ( qw/ name desc / ) { 
     84                                    $clone->$_($arg->{$_}) if $arg->{$_}; 
     85                                } 
    8486                            } 
     87 
     88                            if ( defined $arg->{pattern} and $arg->{pattern} =~ m!/(.+)/! ) { 
     89                                $clone->pattern($1); 
     90                            } 
     91 
     92 
     93                            if ( defined $arg->{required} 
     94                                     and ( $arg->{required} eq 'yes' or $arg->{required} eq 'true' ) ) { 
     95                                $clone->required(1); 
     96                            } 
     97 
    8598                            $hash->{$key} = $curry->($clone, [ $arg->{$key} ]); 
    8699                        } 
    …… 
    103116 
    104117    for ( @elements ) { 
    105         pop @{$_->stack}; 
    106118        my $name  = join '.', @{$_->stack}; 
    107119        my $label = $_->name || $name; 
    …… 
    119131        $element->comment($_->desc); 
    120132 
     133        # set constraints 
    121134        $self->constraint('Integer', $name) if $_->type eq 'int'; 
    122         $self->constraint('String',  $name) if $_->type eq 'str'; 
     135        #$self->constraint('String',  $name) if $_->type eq 'str'; 
     136        #$self->constraint('All', $name) if $_->required; 
     137 
     138        if ( $_->pattern ) { 
     139            my $c = $self->constraint('Regex', $name); 
     140            $c->regex($_->pattern); 
     141        } 
    123142    } 
    124143 
    125144    return $self; 
     145} 
     146 
     147{ 
     148    no warnings 'redefine'; 
     149    *HTML::Element::_xml_escape = sub { 
     150        foreach my $x (@_) { 
     151            $x =~ s!([<&>])!'&#'.(ord($1)).';'!seg; 
     152        } 
     153        return; 
     154    }; 
    126155} 
    127156 
    …… 
    131160use Storable; 
    132161 
    133 __PACKAGE__->mk_accessors( qw/ stack type enum name desc / ); 
     162__PACKAGE__->mk_accessors( qw/ stack type enum name desc pattern required / ); 
    134163 
    135164sub new { 
    …… 
    175204} 
    176205 
    177 1; # Magic true value required at end of module 
     2061; 
    178207__END__ 
    179208 
    …… 
    292321=head1 AUTHOR 
    293322 
    294 Gosuke Miyashita  C<< <gosukenator@gmail.com> >> 
     323Gosuke Miyashita  C<< <gosukenator at gmail.com> >> 
    295324 
    296325 
    297326=head1 LICENCE AND COPYRIGHT 
    298327 
    299 Copyright (c) 2006, Gosuke Miyashita C<< <gosukenator@gmail.com> >>. All rights reserved. 
     328Copyright (c) 2006, Gosuke Miyashita C<< <gosukenator at gmail.com> >>. All rights reserved. 
    300329 
    301330This module is free software; you can redistribute it and/or