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

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

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

revision 1.14 by wakaba, Sun Jul 7 00:46:07 2002 UTC revision 1.15 by wakaba, Thu Aug 1 09:19:46 2002 UTC
# Line 7  field body consist of comma separated va Line 7  field body consist of comma separated va
7  =cut  =cut
8    
9  package Message::Field::CSV;  package Message::Field::CSV;
10  require 5.6.0;  require 5.6.0;  ## eval 're'
11  use strict;  use strict;
12  use re 'eval';  use vars qw(%DEFAULT @ISA %REG $VERSION);
 use vars qw(@ISA %REG $VERSION);  
13  $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
 require Message::Util;  
14  require Message::Field::Structured;  require Message::Field::Structured;
15  push @ISA, qw(Message::Field::Structured);  push @ISA, qw(Message::Field::Structured);
16    
17  use overload '""' => sub { $_[0]->stringify },  use overload '""' => sub { $_[0]->stringify },
18               '0+' => sub { $_[0]->count },               '0+' => sub { $_[0]->count },
              '@{}' => sub { $_[0]->{value} },   ## SHOULD NOT be used  
19               '.=' => sub { $_[0]->add ($_[1]); $_[0] },               '.=' => sub { $_[0]->add ($_[1]); $_[0] },
20               fallback => 1;               fallback => 1;
21    
22  *REG = \%Message::Util::REG;  %REG = %Message::Util::REG;
23  ## Inherited: comment, quoted_string, domain_literal, angle_quoted  ## Inherited: comment, quoted_string, domain_literal, angle_quoted
24          ## WSP, FWS, atext          ## WSP, FWS, atext
25            
26  ## From usefor-article          ## From usefor-article
27          $REG{NON_component} = qr/[^\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5F\x61-\x7A\x80-\xFF\x2F\x3D\x3F]/;          $REG{NON_component} = qr/[^\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5F\x61-\x7A\x80-\xFF\x2F\x3D\x3F]/;
28          $REG{NON_distribution} = qr/[^\x21\x2B\x2D\x30-\x39\x41-\x5A\x5F\x61-\x7A]/;          $REG{NON_distribution} = qr/[^\x21\x2B\x2D\x30-\x39\x41-\x5A\x5F\x61-\x7A]/;
29    
30    %DEFAULT = (
31            -_ARRAY_NAME    => 'value',
32            -_MEMBERS       => [qw|value_type|],
33            -_METHODS       => [qw|add  count delete item
34                           comment_add comment_delete comment_count
35                           comment_item|],  # replace (not implemented yet)
36            #encoding_after_encode
37            #encoding_before_decode
38            #field_param_name
39            #field_name
40            #field_ns
41            #format
42            #header_default_charset
43            #header_default_charset_input
44            #hook_encode_string
45            #hook_decode_string
46        -is_quoted_string   => 1,   ## Can it be itself a quoted-string?
47        -long_count => 10,
48            #parse_all
49        -remove_comment     => 1,
50        -separator  => ', ',
51        -separator_long     => ', ',
52        -use_comment        => 1,
53        -max        => 0,
54        #value_type
55        -value_unsafe_rule  => 'NON_http_token_wsp',
56    );
57    
58  =head1 CONSTRUCTORS  =head1 CONSTRUCTORS
59    
60  The following methods construct new objects:  The following methods construct new objects:
# Line 42  The following methods construct new obje Line 67  The following methods construct new obje
67  sub _init ($;%) {  sub _init ($;%) {
68    my $self = shift;    my $self = shift;
69    my %options = @_;    my %options = @_;
   my %DEFAULT = (  
     -_ARRAY_NAME        => 'value',  
     -_MEMBERS   => [qw|value_type|],  
     -_METHODS   => [qw|add replace count delete item  
                        comment_add comment_delete comment_count  
                        comment_item|],  
     #encoding_after_encode  
     #encoding_before_decode  
     -field_name => 'keywords',  
     #format  
     #hook_encode_string  
     #hook_decode_string  
     -is_quoted_string   => 1,   ## Can itself quoted-string?  
     -long_count => 10,  
     -parse_all  => 0,  
     -remove_comment     => 1,  
     -separator  => ', ',  
     -separator_long     => ', ',  
     -use_comment        => 1,  
     -max        => 0,  
     #value_type  
     -value_unsafe_rule  => 'NON_http_token_wsp',  
   );  
70    $self->SUPER::_init (%DEFAULT, %options);    $self->SUPER::_init (%DEFAULT, %options);
71    $self->{value} = [];    
   
 ## Keywords: foo, bar, "and so on"  
 ## Newsgroups: local.test,local.foo,local.bar  
 ## Accept: text/html; q=1.0, text/plain; q=0.03; *; q=0.01  
   
72    my %field_type = qw(accept-charset accept accept-encoding accept    my %field_type = qw(accept-charset accept accept-encoding accept
73       accept-language accept followup-to newsgroups       accept-language accept followup-to newsgroups
74       posted-to newsgroups       posted-to newsgroups
# Line 111  sub _init ($;%) { Line 108  sub _init ($;%) {
108      $self->{option}->{is_quoted_string} = 0;      $self->{option}->{is_quoted_string} = 0;
109      $self->{option}->{remove_comment} = 0;      $self->{option}->{remove_comment} = 0;
110      $self->{option}->{value_type}->{'*default'} = ['Message::Field::URI'];      $self->{option}->{value_type}->{'*default'} = ['Message::Field::URI'];
   #} elsif ($field_name eq 'p3p') {  
   #  $self->{option}->{is_quoted_string} = 0;  
   #  $self->{option}->{value_type}->{'*default'} = ['Message::Field::Params'];  
111    } elsif ($field_name eq 'encrypted') {    } elsif ($field_name eq 'encrypted') {
112      $self->{option}->{max} = 2;      $self->{option}->{max} = 2;
113    }    }
# Line 155  sub parse ($$;%) { Line 149  sub parse ($$;%) {
149    
150  ## Parses csv string and returns array  ## Parses csv string and returns array
151  sub _parse_list ($$) {  sub _parse_list ($$) {
152      use re 'eval';
153    my $self = shift;    my $self = shift;
154    my $fb = shift;    my $fb = shift;
155    my @ids;    my @ids;
# Line 185  Returns C<$index>'th value(s). Line 180  Returns C<$index>'th value(s).
180    
181  =cut  =cut
182    
183  sub value ($@) {  sub value ($@) { shift->item (@_) }
   my $self = shift;  
   my @index = @_;  
   my @ret = ();  
   for (@index) {  
     $self->{value}->[$_] = $self->_parse_value ('*default' => $self->{value}->[$_]);  
     push @ret, $self->{value}->[$_];  
   }  
   @ret;  
 }  
184    
185  =item $number = $csv->count  =item $number = $csv->count
186    
# Line 202  Returns number of values. Line 188  Returns number of values.
188    
189  =cut  =cut
190    
191  sub count ($) {  ## Inherited
   my $self = shift;  
   $self->_delete_empty;  
   $#{$self->{value}}+1;  
 }  
192    
193  =iterm $csv->add ($value1, [$value2, $value3,...])  =iterm $csv->add ($value1, [$value2, $value3,...])
194    
# Line 223  sub _add_array_check ($$\%) { Line 205  sub _add_array_check ($$\%) {
205    }    }
206    (1, value => $value);    (1, value => $value);
207  }  }
208    *_replace_array_check = \&_add_array_check;
209    
210  =item $field-body = $csv->stringify ()  =item $field-body = $csv->stringify ()
211    
# Line 284  is automatically used). Line 267  is automatically used).
267    
268  Set value-type.  Set value-type.
269    
 =cut  
   
 sub value_type ($;$) {  
   my $self = shift;  
   my $new_value_type = shift;  
   if (ref $new_value_type eq 'ARRAY') {  
     $self->{option}->{value_type} = $new_value_type;  
   } elsif ($new_value_type) {  
     $self->{option}->{value_type}->[0] = $new_value_type;  
   }  
   $self->{option}->{value_type}->[0] || ':none:';  
 }  
   
270  =item $clone = $ua->clone ()  =item $clone = $ua->clone ()
271    
272  Returns a copy of the object.  Returns a copy of the object.
273    
274  =cut  =cut
275    
276  ## clone, method_available: Inherited  ## value_type, clone, method_available: Inherited
277    
278  =back  =back
279    
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24