/[suikacvs]/messaging/manakai/lib/Message/Field/Structured.pm
Suika

Diff of /messaging/manakai/lib/Message/Field/Structured.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by wakaba, Sat May 4 06:03:58 2002 UTC revision 1.10 by wakaba, Wed May 8 09:11:31 2002 UTC
# Line 32  sub _init ($;%) { Line 32  sub _init ($;%) {
32    $self->{option} = Message::Util::make_clone ({    $self->{option} = Message::Util::make_clone ({
33      _ARRAY_NAME => '',      _ARRAY_NAME => '',
34      _HASH_NAME  => '',      _HASH_NAME  => '',
35        _MATHODS    => [qw(as_plain_string)],
36        by  => 'index',     ## (Reserved for method level option)
37      dont_croak  => 0,   ## Don't die unless very very fatal error      dont_croak  => 0,   ## Don't die unless very very fatal error
38      encoding_after_encode       => '*default',      encoding_after_encode       => '*default',
39      encoding_before_decode      => '*default',      encoding_before_decode      => '*default',
# Line 110  sub add ($$$%) { Line 112  sub add ($$$%) {
112      if (ref $_[0] eq 'HASH') {      if (ref $_[0] eq 'HASH') {
113        my $option = shift (@_);        my $option = shift (@_);
114        for (keys %$option) {my $n = $_; $n =~ s/^-//; $option{$n} = $$option{$_}}        for (keys %$option) {my $n = $_; $n =~ s/^-//; $option{$n} = $$option{$_}}
115          $option{parse} = 1 if defined wantarray && !defined $option{parse};
116      }      }
117            
118      ## Additional items      ## Additional items
# Line 117  sub add ($$$%) { Line 120  sub add ($$$%) {
120      for (@_) {      for (@_) {
121        my ($ok, undef, $avalue) = $self->_add_array_check ($_, \%option);        my ($ok, undef, $avalue) = $self->_add_array_check ($_, \%option);
122        if ($ok) {        if ($ok) {
123            $avalue = $self->_parse_value ('*default' => $avalue) if $option{parse};
124          if ($option{prepend}) {          if ($option{prepend}) {
125            unshift @{$self->{$array}}, $avalue;            unshift @{$self->{$array}}, $avalue;
126          } else {          } else {
# Line 150  sub add ($$$%) { Line 154  sub add ($$$%) {
154        next if $name =~ /^-/; $name =~ s/^\\//;        next if $name =~ /^-/; $name =~ s/^\\//;
155                
156        my $ok;        my $ok;
157        ($ok, undef, $avalue) = $self->_add_hash_check ($name => $value, \%option);        ($ok, $name, $avalue) = $self->_add_hash_check ($name => $value, \%option);
158        if ($ok) {        if ($ok) {
159            $avalue = $self->_parse_value ($name => $avalue) if $option{parse};
160          if ($option{prepend}) {          if ($option{prepend}) {
161            unshift @{$self->{$array}}, $avalue;            unshift @{$self->{$array}}, $avalue;
162          } else {          } else {
# Line 259  sub replace ($$$%) { Line 264  sub replace ($$$%) {
264  }  }
265    
266  sub _replace_cleaning ($) {  sub _replace_cleaning ($) {
267    # $_[0]->_delete_empty;    $_[0]->_delete_empty;
268  }  }
269  sub _replace_array_check ($$\%) {  sub _replace_array_check ($$\%) {
270    shift; 1, $_[0] => $_[0];    shift; 1, $_[0] => $_[0];
# Line 299  sub count ($;%) { Line 304  sub count ($;%) {
304    $#{$self->{$array}} + 1;    $#{$self->{$array}} + 1;
305  }  }
306  sub _count_cleaning ($) {  sub _count_cleaning ($) {
307    # $_[0]->_delete_empty;    $_[0]->_delete_empty;
308  }  }
309  sub _count_by_name ($$\%) {  sub _count_by_name ($$\%) {
310    # my $self = shift;    # my $self = shift;
# Line 309  sub _count_by_name ($$\%) { Line 314  sub _count_by_name ($$\%) {
314    # $#a + 1;    # $#a + 1;
315  }  }
316    
317    sub delete ($@) {
318      my $self = shift;
319      my %p; %p = %{shift (@_)} if ref $_[0] eq 'HASH';
320      my %option = %{$self->{option}};
321      for (grep {/^-/} keys %p) {$option{substr ($_, 1)} = $p{$_}}
322      my $array = $option{_ARRAY_NAME} || $option{_HASH_NAME};
323      unless ($array) {
324        return if $option{dont_croak};
325        Carp::croak q{delete: Method not available for this module};
326      }
327      if ($option{by} && $option{by} ne 'index') {
328        my %name; for (@_) {$name{$_} = 1}
329        for (@{$self->{$array}}) {
330          if ($self->_delete_match ($option{by}, \$_, \%name, \%option)) {
331            $_ = undef;
332          }
333        }
334      } else {      ## by index
335        for (@_) {
336          $self->{$array}->[$_] = undef;
337        }
338      }
339      $self->_delete_cleaning;
340    }
341    
342    ## delete-by?, \$checked-item, \%delete-list, \%option
343    sub _delete_match ($$\$\%\%) {
344      0 #return 1 / 0
345    }
346    
347    sub _delete_cleaning ($) {
348      $_[0]->_delete_empty;
349    }
350    
351  ## Delete empty items  ## Delete empty items
352  sub _delete_empty ($) {  sub _delete_empty ($) {
353    # my $self = shift;    # my $self = shift;
# Line 316  sub _delete_empty ($) { Line 355  sub _delete_empty ($) {
355    # $self;    # $self;
356  }  }
357    
358    sub item ($$;%) {
359      my $self = shift;
360      my ($name, %p) = (shift, @_);
361      return $self->replace ($name => $p{-value}, @_) if defined $p{-value};
362      my %option = %{$self->{option}};
363      for (grep {/^-/} keys %p) {$option{substr ($_, 1)} = $p{$_}}
364      my $array = $option{_ARRAY_NAME} || $option{_HASH_NAME};
365      unless ($array) {
366        return if $option{dont_croak};
367        Carp::croak q{item: Method not available for this module};
368      }
369      if ($option{by} eq 'index') {
370        for ($self->{$array}->[$name]) {
371          return $self->_item_return_value (\$_, \%option);
372        }
373      } else {
374        my @r;
375        for (@{$self->{$array}}) {
376          if ($self->_item_match ($option{by}, \$_, {$name => 1}, \%option)) {
377            if (wantarray) {
378              push @r, $self->_item_return_value (\$_, \%option);
379            } else {
380              return $self->_item_return_value (\$_, \%option);
381            }
382          }
383        }
384        return undef unless wantarray;
385        (@r);
386      }
387    }
388    
389    ## item-by?, \$checked-item, {item-key => 1}, \%option
390    sub _item_match ($$\$\%\%) {
391      0 #return 1 / 0
392    }
393    
394    ## Returns returned item value    \$item-value, \%option
395    sub _item_return_value ($\$\%) {
396      $_[1]
397    }
398    
399  ## $self->_parse_value ($type, $value);  ## $self->_parse_value ($type, $value);
400  sub _parse_value ($$$) {  sub _parse_value ($$$) {
401    my $self = shift;    my $self = shift;
# Line 347  sub _parse_value ($$$) { Line 427  sub _parse_value ($$$) {
427    }    }
428  }  }
429    
430    sub scan ($&) {
431      my ($self, $sub) = @_;
432      my %p = @_; my %option = %{$self->{option}};
433      for (grep {/^-/} keys %p) {$option{substr ($_, 1)} = $p{$_}}
434      my $array = $self->{option}->{_ARRAY_NAME}
435               || $self->{option}->{_HASH_NAME};
436      my @param = @{$self->{$array}};
437      my $sort = $option{sort};
438      @param = sort $sort @param if ref $sort;
439      for my $param (@param) {
440        &$sub($self, $param);
441      }
442    }
443    
444  =head1 METHODS  =head1 METHODS
445    
446  =over 4  =over 4
# Line 454  sub _n11n_field_name ($$) { Line 548  sub _n11n_field_name ($$) {
548    $s;    $s;
549  }  }
550    
551    my %_method_default_list = qw(new 1 parse 1 stringify 1 option 1 clone 1 method_available 1);
552    sub method_available ($$) {
553      my $self = shift;
554      my $name = shift;
555      return 1 if $_method_default_list{$name};
556      for (@{$self->{option}->{_METHODS}}) {
557        return 1 if $_ eq $name;
558      }
559      0;
560    }
561    
562  =head1 EXAMPLE  =head1 EXAMPLE
563    
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24