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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.12 - (hide annotations) (download)
Sun Jun 9 11:08:27 2002 UTC (22 years, 5 months ago) by wakaba
Branch: MAIN
Changes since 1.11: +13 -14 lines
2002-06-09  wakaba <w@suika.fam.cx>

	* Addresses.pm (_delete_match): 'addr-spec': new 'by' option.
	* ContentType.pm:
	- (_save_param): Call _parse_param_value if parse_all.
	- (_parse_value): New function.  Check Message::MIME::MediaType.
	* CSV.pm (use_comment): New option.
	* Date.pm:
	- (zone): New method.
	- (set_datetime): Likewise.
	* Mailbox.pm (display_name): New method.
	* Numval.pm (use_comment): New option.
	* Param.pm (_parse_param_value): New function.
	* Structured.pm:
	- (_add_return_value, _replace_return_value): New functions.
	- (_parse_value): Sync with Message::Entity's.
	- (option): Sync with Message::Entity's.
	- (option): '-recursive': new option.
	- (_option_recursive): New function.

1 wakaba 1.1
2     =head1 NAME
3    
4 wakaba 1.7 Message::Field::CSV --- Perl module for Internet message
5     field body consist of comma separated values
6 wakaba 1.1
7     =cut
8    
9     package Message::Field::CSV;
10     require 5.6.0;
11     use strict;
12     use re 'eval';
13 wakaba 1.7 use vars qw(@ISA %REG $VERSION);
14 wakaba 1.12 $VERSION=do{my @r=(q$Revision: 1.11 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
15 wakaba 1.4 require Message::Util;
16 wakaba 1.7 require Message::Field::Structured;
17     push @ISA, qw(Message::Field::Structured);
18    
19     use overload '""' => sub { $_[0]->stringify },
20     '0+' => sub { $_[0]->count },
21 wakaba 1.9 '@{}' => sub { $_[0]->{value} }, ## SHOULD NOT be used
22 wakaba 1.7 '.=' => sub { $_[0]->add ($_[1]); $_[0] },
23     fallback => 1;
24    
25     *REG = \%Message::Util::REG;
26     ## Inherited: comment, quoted_string, domain_literal, angle_quoted
27     ## WSP, FWS, atext
28    
29     ## From usefor-article
30     $REG{NON_component} = qr/[^\x2B\x2D\x2E\x30-\x39\x41-\x5A\x5F\x61-\x7A\x80-\xFF\x2F\x3D\x3F]/;
31     $REG{NON_distribution} = qr/[^\x21\x2B\x2D\x30-\x39\x41-\x5A\x5F\x61-\x7A]/;
32    
33     =head1 CONSTRUCTORS
34    
35     The following methods construct new objects:
36    
37     =over 4
38    
39     =cut
40    
41     ## Initialize of this class -- called by constructors
42     sub _init ($;%) {
43     my $self = shift;
44     my %options = @_;
45     my %DEFAULT = (
46 wakaba 1.10 -_ARRAY_NAME => 'value',
47 wakaba 1.11 -_MEMBERS => [qw|value_type|],
48     -_METHODS => [qw|add replace count delete item
49     comment_add comment_delete comment_count
50     comment_item|],
51 wakaba 1.9 #encoding_after_encode
52     #encoding_before_decode
53 wakaba 1.7 -field_name => 'keywords',
54 wakaba 1.9 #format
55     #hook_encode_string
56     #hook_decode_string
57 wakaba 1.7 -is_quoted_string => 1, ## Can itself quoted-string?
58     -long_count => 10,
59     -parse_all => 0,
60     -remove_comment => 1,
61     -separator => ', ',
62     -separator_long => ', ',
63 wakaba 1.12 -use_comment => 1,
64 wakaba 1.7 -max => 0,
65 wakaba 1.9 #value_type
66 wakaba 1.7 -value_unsafe_rule => 'NON_http_token_wsp',
67     );
68     $self->SUPER::_init (%DEFAULT, %options);
69     $self->{value} = [];
70 wakaba 1.1
71     ## Keywords: foo, bar, "and so on"
72     ## Newsgroups: local.test,local.foo,local.bar
73     ## Accept: text/html; q=1.0, text/plain; q=0.03; *; q=0.01
74    
75     my %field_type = qw(accept-charset accept accept-encoding accept
76 wakaba 1.12 accept-language accept followup-to newsgroups
77 wakaba 1.6 posted-to newsgroups
78 wakaba 1.10 x-brother x-moe x-boss x-moe x-classmate x-moe x-daughter x-moe
79 wakaba 1.12 x-dearfriend x-moe x-favoritesong x-moe
80 wakaba 1.9 x-friend x-moe x-me x-moe
81     x-respect x-moe x-sister x-moe x-son x-moe x-sublimate x-moe x-wife x-moe);
82 wakaba 1.12 my $field_name = $self->{option}->{field_name};
83 wakaba 1.1 $field_name = $field_type{$field_name} || $field_name;
84 wakaba 1.2 if ($field_name eq 'newsgroups') {
85     $self->{option}->{separator} = ',';
86 wakaba 1.4 $self->{option}->{separator_long} = ', ';
87     $self->{option}->{long_count} = 5;
88     $self->{option}->{value_unsafe_rule} = 'NON_component';
89 wakaba 1.5 $self->{option}->{encoding_after_encode} = 'utf-8';
90 wakaba 1.4 } elsif ($field_name eq 'distribution') {
91     $self->{option}->{separator} = ',';
92     $self->{option}->{separator_long} = ', ';
93     $self->{option}->{long_count} = 15;
94     $self->{option}->{value_unsafe_rule} = 'NON_distribution';
95 wakaba 1.2 } elsif ($field_name eq 'x-moe') {
96 wakaba 1.7 $self->{option}->{is_quoted_string} = 0;
97 wakaba 1.9 $self->{option}->{value_type}->{'*default'} = ['Message::Field::XMoe'];
98 wakaba 1.1 } elsif ($field_name eq 'accept') {
99 wakaba 1.7 $self->{option}->{is_quoted_string} = 0;
100 wakaba 1.9 $self->{option}->{value_type}->{'*default'} = ['Message::Field::ValueParams'];
101 wakaba 1.12 } elsif ($self->{option}->{field_ns} eq $Message::Header::NS_phname2uri{list}) {
102     $self->{option}->{is_quoted_string} = 0;
103     $self->{option}->{remove_comment} = 0;
104     $self->{option}->{value_type}->{'*default'} = ['Message::Field::URI'];
105     } elsif ($field_name eq 'uri') {
106 wakaba 1.7 $self->{option}->{is_quoted_string} = 0;
107     $self->{option}->{remove_comment} = 0;
108 wakaba 1.9 $self->{option}->{value_type}->{'*default'} = ['Message::Field::URI'];
109 wakaba 1.8 #} elsif ($field_name eq 'p3p') {
110     # $self->{option}->{is_quoted_string} = 0;
111 wakaba 1.9 # $self->{option}->{value_type}->{'*default'} = ['Message::Field::Params'];
112 wakaba 1.1 } elsif ($field_name eq 'encrypted') {
113     $self->{option}->{max} = 2;
114     }
115 wakaba 1.7
116     if (ref $options{value} eq 'ARRAY') {
117     $self->add (@{$options{value}});
118     } elsif ($options{value}) {
119     $self->add ($options{value});
120     }
121 wakaba 1.1 $self;
122     }
123    
124 wakaba 1.7 =item $csv = Message::Field::CSV->new ([%options])
125 wakaba 1.1
126 wakaba 1.7 Constructs a new object. You might pass some options as parameters
127     to the constructor.
128 wakaba 1.1
129     =cut
130    
131 wakaba 1.7 ## Inherited
132 wakaba 1.1
133 wakaba 1.7 =item $csv = Message::Field::CSV->parse ($field-body, [%options])
134 wakaba 1.1
135 wakaba 1.7 Constructs a new object with given field body. You might pass
136     some options as parameters to the constructor.
137 wakaba 1.1
138     =cut
139    
140     sub parse ($$;%) {
141 wakaba 1.7 my $class = shift;
142     my $self = bless {}, $class;
143 wakaba 1.1 my $field_body = shift;
144 wakaba 1.7 $self->_init (@_);
145     $field_body = Message::Util::delete_comment ($field_body)
146 wakaba 1.12 if $self->{option}->{use_comment} && $self->{option}->{remove_comment};
147 wakaba 1.7 push @{$self->{value}}, $self->_parse_list ($field_body);
148 wakaba 1.1 $self;
149     }
150    
151 wakaba 1.7 ## Parses csv string and returns array
152 wakaba 1.1 sub _parse_list ($$) {
153     my $self = shift;
154     my $fb = shift;
155     my @ids;
156 wakaba 1.7 $fb =~ s{((?:$REG{quoted_string}|$REG{angle_quoted}|$REG{domain_literal}|$REG{comment}|[^\x22\x28\x2C\x3C\x5B])+)}{
157 wakaba 1.1 my $s = $1; $s =~ s/^$REG{WSP}+//; $s =~ s/$REG{WSP}+$//;
158 wakaba 1.7 if ($self->{option}->{is_quoted_string}) {
159 wakaba 1.9 $s = $self->_parse_value ('*default' =>
160     Message::Util::decode_quoted_string ($self, $s))
161 wakaba 1.7 if $self->{option}->{parse_all};
162     push @ids, Message::Util::decode_quoted_string ($self, $s);
163 wakaba 1.1 } else {
164 wakaba 1.9 $s = $self->_parse_value ('*default' => $s) if $self->{option}->{parse_all};
165 wakaba 1.7 push @ids, $s;
166 wakaba 1.1 }
167     }goex;
168     @ids;
169     }
170    
171 wakaba 1.7 =back
172    
173     =head1 METHODS
174    
175     =over 4
176    
177     =head2 $values = $csv->value ($index1, [$index2, $index3,...])
178    
179     Returns C<$index>'th value(s).
180    
181     =cut
182    
183     sub value ($@) {
184     my $self = shift;
185     my @index = @_;
186     my @ret = ();
187     for (@index) {
188 wakaba 1.9 $self->{value}->[$_] = $self->_parse_value ('*default' => $self->{value}->[$_]);
189 wakaba 1.7 push @ret, $self->{value}->[$_];
190     }
191     @ret;
192     }
193    
194     =item $number = $csv->count
195 wakaba 1.1
196 wakaba 1.7 Returns number of values.
197 wakaba 1.1
198     =cut
199    
200 wakaba 1.7 sub count ($) {
201     my $self = shift;
202     $self->_delete_empty;
203     $#{$self->{value}}+1;
204     }
205    
206     =iterm $csv->add ($value1, [$value2, $value3,...])
207    
208     Adds (appends) new value(s).
209 wakaba 1.1
210     =cut
211    
212 wakaba 1.10 sub _add_array_check ($$\%) {
213 wakaba 1.1 my $self = shift;
214 wakaba 1.10 my ($value, $option) = @_;
215     my $value_option = {};
216     if (ref $value eq 'ARRAY') {
217     ($value, %$value_option) = @$value;
218     }
219     (1, value => $value);
220 wakaba 1.1 }
221    
222 wakaba 1.7 =item $field-body = $csv->stringify ()
223    
224     Returns C<field-body> as a string.
225    
226     =cut
227    
228 wakaba 1.1 sub stringify ($;%) {
229     my $self = shift;
230 wakaba 1.7 my %o = @_;
231     my %option = %{$self->{option}};
232     for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
233     $self->_delete_empty;
234 wakaba 1.1 $option{max}--;
235 wakaba 1.12 $option{max} = $#{$self->{value}} if $option{max} < 0;
236 wakaba 1.7 $option{max} = $#{$self->{value}} if $#{$self->{value}} < $option{max};
237 wakaba 1.4 $option{separator} = $option{separator_long}
238     if $option{max} >= $option{long_count};
239 wakaba 1.1 join $option{separator},
240 wakaba 1.10 map {$self->_stringify_item ($_, \%option)} @{$self->{value}}[0..$option{max}];
241     }
242     *as_string = \&stringify;
243    
244     sub _stringify_item ($$\%) {
245     my $self = shift;
246     my $item = shift;
247     my $option = shift;
248     if ($$option{is_quoted_string}) {
249     my %s = &{$$option{hook_encode_string}} ($self,
250     $item, type => 'phrase');
251 wakaba 1.7 Message::Util::quote_unsafe_string ($s{value},
252 wakaba 1.10 unsafe => $$option{value_unsafe_rule});
253 wakaba 1.3 } else {
254 wakaba 1.10 $item;
255 wakaba 1.3 }
256 wakaba 1.1 }
257 wakaba 1.7
258 wakaba 1.11 =item $option-value = $csv->option ($option-name)
259 wakaba 1.7
260     Gets option value.
261 wakaba 1.1
262 wakaba 1.7 =item $csv->option ($option-name, $option-value, ...)
263 wakaba 1.4
264 wakaba 1.7 Set option value(s). You can pass multiple option name-value pair
265     as parameter when setting.
266 wakaba 1.4
267     =cut
268    
269 wakaba 1.7 ## Inherited
270    
271     =item $type = $csv->value_type
272    
273     Gets value-type. Value-type is package name of module
274     used for value modification. A special value-type, ':none:'
275     is used to indicate values are non-structured (and no module
276     is automatically used).
277    
278     =item $csv->value_type ([$type])
279    
280     Set value-type.
281    
282     =cut
283 wakaba 1.4
284 wakaba 1.7 sub value_type ($;$) {
285 wakaba 1.5 my $self = shift;
286     my $new_value_type = shift;
287 wakaba 1.7 if (ref $new_value_type eq 'ARRAY') {
288     $self->{option}->{value_type} = $new_value_type;
289     } elsif ($new_value_type) {
290 wakaba 1.5 $self->{option}->{value_type}->[0] = $new_value_type;
291     }
292     $self->{option}->{value_type}->[0] || ':none:';
293     }
294    
295 wakaba 1.7 =item $clone = $ua->clone ()
296 wakaba 1.1
297 wakaba 1.7 Returns a copy of the object.
298 wakaba 1.1
299 wakaba 1.7 =cut
300 wakaba 1.1
301 wakaba 1.11 ## clone, method_available: Inherited
302 wakaba 1.1
303 wakaba 1.7 =back
304 wakaba 1.1
305     =cut
306    
307 wakaba 1.7 ## Internal functions
308 wakaba 1.1
309 wakaba 1.7 sub _delete_empty ($) {
310 wakaba 1.1 my $self = shift;
311 wakaba 1.7 $self->{value} = [grep {length $_} @{$self->{value}}];
312 wakaba 1.1 }
313    
314     =head1 LICENSE
315    
316     Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
317    
318     This program is free software; you can redistribute it and/or modify
319     it under the terms of the GNU General Public License as published by
320     the Free Software Foundation; either version 2 of the License, or
321     (at your option) any later version.
322    
323     This program is distributed in the hope that it will be useful,
324     but WITHOUT ANY WARRANTY; without even the implied warranty of
325     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
326     GNU General Public License for more details.
327    
328     You should have received a copy of the GNU General Public License
329     along with this program; see the file COPYING. If not, write to
330     the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
331     Boston, MA 02111-1307, USA.
332    
333     =head1 CHANGE
334    
335     See F<ChangeLog>.
336 wakaba 1.12 $Date: 2002/05/16 11:43:40 $
337 wakaba 1.1
338     =cut
339    
340     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24