/[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.3 by wakaba, Mon Mar 25 10:15:26 2002 UTC revision 1.4 by wakaba, Sun Mar 31 13:11:55 2002 UTC
# Line 21  use vars qw(%OPTION %REG $VERSION); Line 21  use vars qw(%OPTION %REG $VERSION);
21  $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};
22  use overload '@{}' => sub {[shift->value]},  use overload '@{}' => sub {[shift->value]},
23               '""' => sub {shift->stringify};               '""' => sub {shift->stringify};
24    require Message::Util;
25  $REG{comment} = qr/\x28(?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x27\x2A-\x5B\x5D-\xFF]+|(??{$REG{comment}}))*\x29/;  $REG{comment} = qr/\x28(?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x27\x2A-\x5B\x5D-\xFF]+|(??{$REG{comment}}))*\x29/;
26  $REG{quoted_string} = qr/\x22(?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\xFF])*\x22/;  $REG{quoted_string} = qr/\x22(?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\xFF])*\x22/;
27  $REG{domain_literal} = qr/\x5B(?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x5A\x5E-\xFF])*\x5D/;  $REG{domain_literal} = qr/\x5B(?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x5A\x5E-\xFF])*\x5D/;
28    $REG{uri_literal} = qr/\x3C[\x09\x20\x21\x23-\x3B\x3D\x3F-\x5B\x5D\x5F\x61-\x7A\x7E]*\x3E/;
29    
30  $REG{WSP} = qr/[\x20\x09]+/;  $REG{WSP} = qr/[\x20\x09]+/;
31  $REG{FWS} = qr/[\x20\x09]*/;  $REG{FWS} = qr/[\x20\x09]*/;
# Line 34  $REG{dot_word} = qr/(?:$REG{atext}|$REG{ Line 35  $REG{dot_word} = qr/(?:$REG{atext}|$REG{
35  $REG{phrase} = qr/(?:$REG{atext}|$REG{quoted_string})(?:$REG{atext}|$REG{quoted_string}|\.|$REG{FWS})*/;  $REG{phrase} = qr/(?:$REG{atext}|$REG{quoted_string})(?:$REG{atext}|$REG{quoted_string}|\.|$REG{FWS})*/;
36  $REG{M_quoted_string} = qr/\x22((?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\xFF])*)\x22/;  $REG{M_quoted_string} = qr/\x22((?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\xFF])*)\x22/;
37  $REG{NON_atom} = qr/[^\x09\x21\x23-\x27\x2A\x2B\x2D\x2F\x30-\x39\x3D\x3F\x41-\x5A\x5E-\x7E\x2E]/;  $REG{NON_atom} = qr/[^\x09\x21\x23-\x27\x2A\x2B\x2D\x2F\x30-\x39\x3D\x3F\x41-\x5A\x5E-\x7E\x2E]/;
38    $REG{NON_atext} = qr/[^\x21\x23-\x27\x2A\x2B\x2D\x2F\x30-\x39\x3D\x3F\x41-\x5A\x5E-\x7E]/;
39    $REG{NON_atext_dot} = qr/[^\x21\x23-\x27\x2A\x2B\x2D-\x39\x3D\x3F\x41-\x5A\x5E-\x7E]/;
40    $REG{NON_atext_dot_wsp} = qr/[^\x09\x20\x21\x23-\x27\x2A\x2B\x2D-\x39\x3D\x3F\x41-\x5A\x5E-\x7E]/;
41    $REG{NON_http_token_wsp} = qr/[^\x09\x20\x21\x23-\x27\x2A\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5E-\x7A\x7C\x7E]/;
42    $REG{NON_component} = qr/[^\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5F\x61-\x7A\x80-\xFF\x2F\x3D\x3F]/;
43    $REG{NON_distribution} = qr/[^\x21\x2B\x2D\x30-\x39\x41-\x5A\x5F\x61-\x7A]/;
44  $REG{S_encoded_word} = qr/=\x3F$REG{atext_dot}\x3F=/;  $REG{S_encoded_word} = qr/=\x3F$REG{atext_dot}\x3F=/;
45    
46  ## Keywords: foo, bar, "and so on"  ## Keywords: foo, bar, "and so on"
# Line 49  $REG{S_encoded_word} = qr/=\x3F$REG{atex Line 56  $REG{S_encoded_word} = qr/=\x3F$REG{atex
56    hook_decode_string    => #sub {shift; (value => shift, @_)},    hook_decode_string    => #sub {shift; (value => shift, @_)},
57          \&Message::Util::decode_header_string,          \&Message::Util::decode_header_string,
58    is_quoted_string      => 1,   ## Can itself quoted-string?    is_quoted_string      => 1,   ## Can itself quoted-string?
59      long_count    => 10,
60      remove_comment        => 1,
61    separator     => ', ',    separator     => ', ',
62      separator_long        => ', ',
63    max   => -1,    max   => -1,
64    value_type    => [':none:'],    value_type    => [':none:'],
65      value_unsafe_rule     => 'NON_http_token_wsp',
66  );  );
67    
68  sub _init_option ($$) {  sub _init_option ($) {
69    my $self = shift;    my $self = shift;
70    my %field_type = qw(accept-charset accept accept-encoding accept    my %field_type = qw(accept-charset accept accept-encoding accept
71       accept-language accept       accept-language accept
72       content-language keywords       content-language keywords
73       followup-to newsgroups       followup-to newsgroups
74         list-archive list- list-digest list- list-help list-
75         list-owner list- list-post list- list-subscribe list-
76         list-unsubscribe list- list-url list- uri list-
77       x-brother x-moe x-daughter x-moe       x-brother x-moe x-daughter x-moe
78       x-respect x-moe x-syster x-moe x-wife x-moe);       x-respect x-moe x-syster x-moe x-wife x-moe);
79    my $field_name = lc shift;    my $field_name = lc $self->{option}->{field_name};
80    $field_name = $field_type{$field_name} || $field_name;    $field_name = $field_type{$field_name} || $field_name;
81    if ($field_name eq 'newsgroups') {    if ($field_name eq 'newsgroups') {
     $self->{option}->{is_quoted_string} = -1;  
82      $self->{option}->{separator} = ',';      $self->{option}->{separator} = ',';
83        $self->{option}->{separator_long} = ', ';
84        $self->{option}->{long_count} = 5;
85        $self->{option}->{value_unsafe_rule} = 'NON_component';
86      } elsif ($field_name eq 'distribution') {
87        $self->{option}->{separator} = ',';
88        $self->{option}->{separator_long} = ', ';
89        $self->{option}->{long_count} = 15;
90        $self->{option}->{value_unsafe_rule} = 'NON_distribution';
91    } elsif ($field_name eq 'x-moe') {    } elsif ($field_name eq 'x-moe') {
92      $self->{option}->{is_quoted_string} = -1;      $self->{option}->{is_quoted_string} = -1;
93      $self->{option}->{value_type} = ['Message::Field::ValueParams'];      $self->{option}->{value_type} = ['Message::Field::ValueParams',
94          {format => $self->{option}->{format}}];
95    } elsif ($field_name eq 'accept') {    } elsif ($field_name eq 'accept') {
96      $self->{option}->{is_quoted_string} = -1;      $self->{option}->{is_quoted_string} = -1;
97      $self->{option}->{value_type} = ['Message::Field::ValueParams'];      $self->{option}->{value_type} = ['Message::Field::ValueParams',
98          {format => $self->{option}->{format}}];
99      } elsif ($field_name eq 'list-') {
100        $self->{option}->{is_quoted_string} = -1;
101        $self->{option}->{remove_comment} = -1;
102        $self->{option}->{value_type} = ['Message::Field::URI',
103          {field_name => $self->{option}->{field_name},
104          format => $self->{option}->{format}}];
105    } elsif ($field_name eq 'encrypted') {    } elsif ($field_name eq 'encrypted') {
106      $self->{option}->{max} = 2;      $self->{option}->{max} = 2;
107    }    }
# Line 90  sub new ($;%) { Line 119  sub new ($;%) {
119    my %option = @_;    my %option = @_;
120    for (%OPTION) {$option{$_} ||= $OPTION{$_}}    for (%OPTION) {$option{$_} ||= $OPTION{$_}}
121    $self->{option} = \%option;    $self->{option} = \%option;
122    $self->_init_option ($self->{option}->{field_name});    $self->_init_option ();
123    $self;    $self;
124  }  }
125    
# Line 106  sub parse ($$;%) { Line 135  sub parse ($$;%) {
135    my %option = @_;    my %option = @_;
136    for (%OPTION) {$option{$_} ||= $OPTION{$_}}    for (%OPTION) {$option{$_} ||= $OPTION{$_}}
137    $self->{option} = \%option;    $self->{option} = \%option;
138    $self->_init_option ($self->{option}->{field_name});    $self->_init_option ();
139    $field_body = $self->_delete_comment ($field_body);    $field_body = $self->_delete_comment ($field_body)
140        unless $option{remove_comment}<0;
141    @{$self->{value}} = $self->_parse_list ($field_body);    @{$self->{value}} = $self->_parse_list ($field_body);
142    $self;    $self;
143  }  }
# Line 116  sub _parse_list ($$) { Line 146  sub _parse_list ($$) {
146    my $self = shift;    my $self = shift;
147    my $fb = shift;    my $fb = shift;
148    my @ids;    my @ids;
149    $fb =~ s{((?:$REG{quoted_string}|$REG{domain_literal}|[^\x22\x2C\x5B])+)}{    $fb =~ s{((?:$REG{quoted_string}|$REG{uri_literal}|$REG{domain_literal}|$REG{comment}|[^\x22\x28\x2C\x3C\x5B])+)}{
150      my $s = $1;  $s =~ s/^$REG{WSP}+//;  $s =~ s/$REG{WSP}+$//;      my $s = $1;  $s =~ s/^$REG{WSP}+//;  $s =~ s/$REG{WSP}+$//;
151      if ($self->{option}->{is_quoted_string}>0) {      if ($self->{option}->{is_quoted_string}>0) {
152        push @ids, $self->_value ($self->_decode_quoted_string ($s));        push @ids, $self->_value ($self->_decode_quoted_string ($s));
# Line 173  sub stringify ($;%) { Line 203  sub stringify ($;%) {
203    my $self = shift;    my $self = shift;
204    my %option = @_;    my %option = @_;
205    $option{separator} ||= $self->{option}->{separator};    $option{separator} ||= $self->{option}->{separator};
206      $option{separator_long} ||= $self->{option}->{separator_long};
207      $option{long_count} ||= $self->{option}->{long_count};
208    $option{max} ||= $self->{option}->{max};    $option{max} ||= $self->{option}->{max};
209    $option{is_quoted_string} ||= $self->{option}->{is_quoted_string};    $option{is_quoted_string} ||= $self->{option}->{is_quoted_string};
210      $option{value_unsafe_rule} ||= $self->{option}->{value_unsafe_rule};
211    $self->_delete_empty ();    $self->_delete_empty ();
212    $option{max}--;    $option{max}--;
213    $option{max} = $#{$self->{value}} if $option{max}<0;    $option{max} = $#{$self->{value}} if $option{max}<0;
214    $option{max} = $#{$self->{value}} if $#{$self->{value}}<$option{max};    $option{max} = $#{$self->{value}} if $#{$self->{value}}<$option{max};
215      $option{separator} = $option{separator_long}
216        if $option{max} >= $option{long_count};
217    join $option{separator},    join $option{separator},
218      map {      map {
219        if ($option{is_quoted_string}>0) {        if ($option{is_quoted_string}>0) {
220          my %s = &{$self->{option}->{hook_encode_string}} ($self,          my %s = &{$self->{option}->{hook_encode_string}} ($self,
221            $_, type => 'phrase');            $_, type => 'phrase');
222          $self->_quote_unsafe_string ($s{value});          $self->_quote_unsafe_string ($s{value},
223              unsafe => $option{value_unsafe_rule});
224        } else {        } else {
225          $_;          $_;
226        }        }
227      } @{$self->{value}}[0..$option{max}];      } @{$self->{value}}[0..$option{max}];
228  }  }
229    
230    =head2 $self->option ($option_name, [$option_value])
231    
232    Set/gets new value of the option.
233    
234    =cut
235    
236    sub option ($$;$) {
237      my $self = shift;
238      my ($name, $value) = @_;
239      if (defined $value) {
240        $self->{option}->{$name} = $value;
241      }
242      $self->{option}->{$name};
243    }
244    
245  sub _delete_empty ($) {  sub _delete_empty ($) {
246    my $self = shift;    my $self = shift;
247    my @nid;    my @nid;
# Line 198  sub _delete_empty ($) { Line 249  sub _delete_empty ($) {
249    $self->{value} = \@nid;    $self->{value} = \@nid;
250  }  }
251    
252  sub _quote_unsafe_string ($$) {  sub _quote_unsafe_string ($$;%) {
253    my $self = shift;    my $self = shift;
254    my $string = shift;    my $string = shift;
255    if ($string =~ /$REG{NON_atom}/ || $string =~ /$REG{WSP}$REG{WSP}+/) {    my %option = @_;
256      $string =~ s/([\x22\x5C])([\x20-\xFF])?/"\x5C$1".($2?"\x5C$2":'')/ge;    $option{unsafe} ||= 'NON_atext_dot';
257      if ($string =~ /$REG{$option{unsafe}}/ || $string =~ /$REG{WSP}$REG{WSP}+/) {
258        $string =~ s/([\x22\x5C])([\x21-\x7E])?/"\x5C$1".(defined $2?"\x5C$2":'')/ge;
259      $string = '"'.$string.'"';      $string = '"'.$string.'"';
260    }    }
261    $string;    $string;
# Line 257  This method is intended to be used for i Line 310  This method is intended to be used for i
310  sub _delete_comment ($$) {  sub _delete_comment ($$) {
311    my $self = shift;    my $self = shift;
312    my $body = shift;    my $body = shift;
313    $body =~ s{($REG{quoted_string}|$REG{domain_literal})|$REG{comment}}{    $body =~ s{($REG{quoted_string}|$REG{uri_literal}|$REG{domain_literal})|$REG{comment}}{
314      my $o = $1;  $o? $o : ' ';      my $o = $1;  $o? $o : ' ';
315    }gex;    }gex;
316    $body;    $body;
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24