Changeset 316

Show
Ignore:
Timestamp:
10/21/06 17:17:32 (2 years ago)
Author:
miya
Message:

HTML::Widget::Kwalify: use CGI::Expand
support dump method

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

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

    r315 r316  
    77use version;our $VERSION = qv('0.0.1'); 
    88 
    9 use base 'HTML::Widget'; 
    10 use YAML qw( LoadFile ); 
     9use base qw( HTML::Widget ); 
     10use YAML qw( LoadFile Dump ); 
    1111use UNIVERSAL; 
     12use CGI::Expand; 
    1213 
    1314*isa = *UNIVERSAL::isa; 
    1415 
    15 sub create_from { 
    16     my ( $class, %args ) = @_; 
    17  
    18     my $yaml = LoadFile($args{file}); 
     16sub new { 
     17    my ( $class, $yaml ) = @_; 
     18 
     19    unless ( ref $yaml ) { 
     20        $yaml = LoadFile($yaml); 
     21    } 
    1922 
    2023    my $self = $class->SUPER::new; 
    2124    return $self->_parse_kwalify_schema($yaml); 
     25} 
     26 
     27sub process { 
     28    my ( $self, $query ) = @_; 
     29 
     30    $self->query($query) if $query; 
     31    $self->SUPER::process($query); 
     32} 
     33 
     34sub dump { 
     35    my $self = shift; 
     36    my $hash = expand_cgi($self->query); 
     37    return Dump( expand_cgi($self->query) ); 
    2238} 
    2339 
    …… 
    4662                    do{ 
    4763                        my $hash = {}; 
    48                         for ( keys %$arg ){ 
    49                             if ( $_ ne 'name' and $_ ne 'desc' ) { 
    50                                 my $clone = $element->clone; 
    51                                 push @{ $clone->stack }, $_ if $_ ne 'type'; 
    52  
    53                                 if ( $_ eq 'type' ) { 
    54                                     push @{ $clone->enum },  @{ $arg->{enum} } if $arg->{enum}; 
    55                                     $clone->name($arg->{name}) if $arg->{name}; 
    56                                 } 
    57  
    58                                 $hash->{$_} = $curry->($clone, [ $arg->{$_} ]); 
     64                        for my $key ( keys %$arg ){ 
     65                            my $clone = $element->clone; 
     66 
     67                            push @{ $clone->stack }, $key 
     68                                unless ( grep { $key eq $_ } ( qw/ mapping sequence desc name / ) ); 
     69 
     70                            if ( $key eq 'sequence' ) { 
     71                                push @{ $clone->stack }, '0'; 
     72                                $clone->name($arg->{name}) if $arg->{name}; 
     73                                $clone->desc($arg->{desc}) if $arg->{desc}; 
    5974                            } 
     75 
     76                            if ( $key eq 'type' ) { 
     77                                push @{ $clone->enum },  @{ $arg->{enum} } if $arg->{enum}; 
     78                                $clone->name($arg->{name}) if $arg->{name}; 
     79                                $clone->desc($arg->{desc}) if $arg->{desc}; 
     80                            } 
     81                            $hash->{$key} = $curry->($clone, [ $arg->{$key} ]); 
    6082                        } 
    6183                        $hash; 
    …… 
    7799 
    78100    for ( @elements ) { 
    79         my $name  = join '_', @{$_->stack}; 
     101        pop @{$_->stack}; 
     102        my $name  = join '.', @{$_->stack}; 
    80103        my $label = $_->name || $name; 
     104 
     105        my $element; 
    81106        if ( @{$_->enum} ){ 
    82             my $enum = $self->element('Select', $name)->label($label); 
    83             $enum->options( map { $_ => $_ } @{$_->enum} ); 
     107            $element = $self->element('Select', $name); 
     108            $element->options( map { $_ => $_ } @{$_->enum} ); 
    84109        } 
    85110        else { 
    86             $self->element( 'Textfield', $name )->label($label); 
    87         } 
     111            $element = $self->element( 'Textfield', $name ); 
     112        } 
     113 
     114        $element->label($label); 
     115        $element->comment($_->desc); 
     116 
     117        $self->constraint('Integer', $name) if $_->type eq 'int'; 
     118        $self->constraint('String',  $name) if $_->type eq 'str'; 
    88119    } 
    89120 
    …… 
    96127use Storable; 
    97128 
    98 __PACKAGE__->mk_accessors( qw/ stack type enum name / ); 
     129__PACKAGE__->mk_accessors( qw/ stack type enum name desc / ); 
    99130 
    100131sub new { 
    …… 
    102133    my $self = { 
    103134        stack => [], 
    104         type  => '', 
    105135        enum  => [], 
    106         name  => '', 
    107136    }; 
    108137    bless $self, $class; 
    …… 
    113142    my $clone = Storable::dclone($self); 
    114143    $clone; 
     144} 
     145 
     146{ 
     147    no warnings 'redefine'; 
     148 
     149    *HTML::Widget::Element::mk_label = sub { 
     150        my ( $self, $w, $name, $comment, $errors ) = @_; 
     151        return unless defined $name; 
     152        my $for = $self->attributes->{id} || $self->id($w); 
     153        my $id  = $for . '_label'; 
     154        my $e   = HTML::Element->new( 'label', for => $for, id => $id ); 
     155        if ($errors) { 
     156            $e->attr( 'class' => 'labels_with_errors' ); 
     157        } 
     158        $e->push_content($name); 
     159        if ($comment) { 
     160            my $c = HTML::Element->new( 
     161                'span', 
     162                id    => "$for\_comment", 
     163                class => 'label_comments' 
     164            ); 
     165            $c->push_content($comment); 
     166            $e->push_content($c); 
     167            $e->push_content($comment); 
     168        } 
     169        return $e; 
     170    }; 
     171 
    115172} 
    116173