/[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.13 - (hide annotations) (download)
Sat Jul 6 10:30:43 2002 UTC (22 years, 4 months ago) by wakaba
Branch: MAIN
Changes since 1.12: +7 -2 lines
2002-06-29  Wakaba <w@suika.fam.cx>

	* ContentType.pm, Params.pm, ValueParams.pm,
	XMoe.pm: Rewritten.

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.13 $VERSION=do{my @r=(q$Revision: 1.12 $=~/\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.13 $self->{option}->{remove_comment} = 0;
101 wakaba 1.9 $self->{option}->{value_type}->{'*default'} = ['Message::Field::ValueParams'];
102 wakaba 1.12 } elsif ($self->{option}->{field_ns} eq $Message::Header::NS_phname2uri{list}) {
103     $self->{option}->{is_quoted_string} = 0;
104     $self->{option}->{remove_comment} = 0;
105     $self->{option}->{value_type}->{'*default'} = ['Message::Field::URI'];
106 wakaba 1.13 } elsif ($field_name eq 'man' || $field_name eq 'opt') {
107     $self->{option}->{is_quoted_string} = 0;
108     $self->{option}->{remove_comment} = 0;
109     $self->{option}->{value_type}->{'*default'} = ['Message::Field::ValueParams'];
110 wakaba 1.12 } elsif ($field_name eq 'uri') {
111 wakaba 1.7 $self->{option}->{is_quoted_string} = 0;
112     $self->{option}->{remove_comment} = 0;
113 wakaba 1.9 $self->{option}->{value_type}->{'*default'} = ['Message::Field::URI'];
114 wakaba 1.8 #} elsif ($field_name eq 'p3p') {
115     # $self->{option}->{is_quoted_string} = 0;
116 wakaba 1.9 # $self->{option}->{value_type}->{'*default'} = ['Message::Field::Params'];
117 wakaba 1.1 } elsif ($field_name eq 'encrypted') {
118     $self->{option}->{max} = 2;
119     }
120 wakaba 1.7
121     if (ref $options{value} eq 'ARRAY') {
122     $self->add (@{$options{value}});
123     } elsif ($options{value}) {
124     $self->add ($options{value});
125     }
126 wakaba 1.1 $self;
127     }
128    
129 wakaba 1.7 =item $csv = Message::Field::CSV->new ([%options])
130 wakaba 1.1
131 wakaba 1.7 Constructs a new object. You might pass some options as parameters
132     to the constructor.
133 wakaba 1.1
134     =cut
135    
136 wakaba 1.7 ## Inherited
137 wakaba 1.1
138 wakaba 1.7 =item $csv = Message::Field::CSV->parse ($field-body, [%options])
139 wakaba 1.1
140 wakaba 1.7 Constructs a new object with given field body. You might pass
141     some options as parameters to the constructor.
142 wakaba 1.1
143     =cut
144    
145     sub parse ($$;%) {
146 wakaba 1.7 my $class = shift;
147     my $self = bless {}, $class;
148 wakaba 1.1 my $field_body = shift;
149 wakaba 1.7 $self->_init (@_);
150     $field_body = Message::Util::delete_comment ($field_body)
151 wakaba 1.12 if $self->{option}->{use_comment} && $self->{option}->{remove_comment};
152 wakaba 1.7 push @{$self->{value}}, $self->_parse_list ($field_body);
153 wakaba 1.1 $self;
154     }
155    
156 wakaba 1.7 ## Parses csv string and returns array
157 wakaba 1.1 sub _parse_list ($$) {
158     my $self = shift;
159     my $fb = shift;
160     my @ids;
161 wakaba 1.7 $fb =~ s{((?:$REG{quoted_string}|$REG{angle_quoted}|$REG{domain_literal}|$REG{comment}|[^\x22\x28\x2C\x3C\x5B])+)}{
162 wakaba 1.1 my $s = $1; $s =~ s/^$REG{WSP}+//; $s =~ s/$REG{WSP}+$//;
163 wakaba 1.7 if ($self->{option}->{is_quoted_string}) {
164 wakaba 1.9 $s = $self->_parse_value ('*default' =>
165     Message::Util::decode_quoted_string ($self, $s))
166 wakaba 1.7 if $self->{option}->{parse_all};
167     push @ids, Message::Util::decode_quoted_string ($self, $s);
168 wakaba 1.1 } else {
169 wakaba 1.9 $s = $self->_parse_value ('*default' => $s) if $self->{option}->{parse_all};
170 wakaba 1.7 push @ids, $s;
171 wakaba 1.1 }
172     }goex;
173     @ids;
174     }
175    
176 wakaba 1.7 =back
177    
178     =head1 METHODS
179    
180     =over 4
181    
182     =head2 $values = $csv->value ($index1, [$index2, $index3,...])
183    
184     Returns C<$index>'th value(s).
185    
186     =cut
187    
188     sub value ($@) {
189     my $self = shift;
190     my @index = @_;
191     my @ret = ();
192     for (@index) {
193 wakaba 1.9 $self->{value}->[$_] = $self->_parse_value ('*default' => $self->{value}->[$_]);
194 wakaba 1.7 push @ret, $self->{value}->[$_];
195     }
196     @ret;
197     }
198    
199     =item $number = $csv->count
200 wakaba 1.1
201 wakaba 1.7 Returns number of values.
202 wakaba 1.1
203     =cut
204    
205 wakaba 1.7 sub count ($) {
206     my $self = shift;
207     $self->_delete_empty;
208     $#{$self->{value}}+1;
209     }
210    
211     =iterm $csv->add ($value1, [$value2, $value3,...])
212    
213     Adds (appends) new value(s).
214 wakaba 1.1
215     =cut
216    
217 wakaba 1.10 sub _add_array_check ($$\%) {
218 wakaba 1.1 my $self = shift;
219 wakaba 1.10 my ($value, $option) = @_;
220     my $value_option = {};
221     if (ref $value eq 'ARRAY') {
222     ($value, %$value_option) = @$value;
223     }
224     (1, value => $value);
225 wakaba 1.1 }
226    
227 wakaba 1.7 =item $field-body = $csv->stringify ()
228    
229     Returns C<field-body> as a string.
230    
231     =cut
232    
233 wakaba 1.1 sub stringify ($;%) {
234     my $self = shift;
235 wakaba 1.7 my %o = @_;
236     my %option = %{$self->{option}};
237     for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
238     $self->_delete_empty;
239 wakaba 1.1 $option{max}--;
240 wakaba 1.12 $option{max} = $#{$self->{value}} if $option{max} < 0;
241 wakaba 1.7 $option{max} = $#{$self->{value}} if $#{$self->{value}} < $option{max};
242 wakaba 1.4 $option{separator} = $option{separator_long}
243     if $option{max} >= $option{long_count};
244 wakaba 1.1 join $option{separator},
245 wakaba 1.10 map {$self->_stringify_item ($_, \%option)} @{$self->{value}}[0..$option{max}];
246     }
247     *as_string = \&stringify;
248    
249     sub _stringify_item ($$\%) {
250     my $self = shift;
251     my $item = shift;
252     my $option = shift;
253     if ($$option{is_quoted_string}) {
254     my %s = &{$$option{hook_encode_string}} ($self,
255     $item, type => 'phrase');
256 wakaba 1.7 Message::Util::quote_unsafe_string ($s{value},
257 wakaba 1.10 unsafe => $$option{value_unsafe_rule});
258 wakaba 1.3 } else {
259 wakaba 1.10 $item;
260 wakaba 1.3 }
261 wakaba 1.1 }
262 wakaba 1.7
263 wakaba 1.11 =item $option-value = $csv->option ($option-name)
264 wakaba 1.7
265     Gets option value.
266 wakaba 1.1
267 wakaba 1.7 =item $csv->option ($option-name, $option-value, ...)
268 wakaba 1.4
269 wakaba 1.7 Set option value(s). You can pass multiple option name-value pair
270     as parameter when setting.
271 wakaba 1.4
272     =cut
273    
274 wakaba 1.7 ## Inherited
275    
276     =item $type = $csv->value_type
277    
278     Gets value-type. Value-type is package name of module
279     used for value modification. A special value-type, ':none:'
280     is used to indicate values are non-structured (and no module
281     is automatically used).
282    
283     =item $csv->value_type ([$type])
284    
285     Set value-type.
286    
287     =cut
288 wakaba 1.4
289 wakaba 1.7 sub value_type ($;$) {
290 wakaba 1.5 my $self = shift;
291     my $new_value_type = shift;
292 wakaba 1.7 if (ref $new_value_type eq 'ARRAY') {
293     $self->{option}->{value_type} = $new_value_type;
294     } elsif ($new_value_type) {
295 wakaba 1.5 $self->{option}->{value_type}->[0] = $new_value_type;
296     }
297     $self->{option}->{value_type}->[0] || ':none:';
298     }
299    
300 wakaba 1.7 =item $clone = $ua->clone ()
301 wakaba 1.1
302 wakaba 1.7 Returns a copy of the object.
303 wakaba 1.1
304 wakaba 1.7 =cut
305 wakaba 1.1
306 wakaba 1.11 ## clone, method_available: Inherited
307 wakaba 1.1
308 wakaba 1.7 =back
309 wakaba 1.1
310     =cut
311    
312 wakaba 1.7 ## Internal functions
313 wakaba 1.1
314 wakaba 1.7 sub _delete_empty ($) {
315 wakaba 1.1 my $self = shift;
316 wakaba 1.7 $self->{value} = [grep {length $_} @{$self->{value}}];
317 wakaba 1.1 }
318    
319     =head1 LICENSE
320    
321     Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
322    
323     This program is free software; you can redistribute it and/or modify
324     it under the terms of the GNU General Public License as published by
325     the Free Software Foundation; either version 2 of the License, or
326     (at your option) any later version.
327    
328     This program is distributed in the hope that it will be useful,
329     but WITHOUT ANY WARRANTY; without even the implied warranty of
330     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
331     GNU General Public License for more details.
332    
333     You should have received a copy of the GNU General Public License
334     along with this program; see the file COPYING. If not, write to
335     the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
336     Boston, MA 02111-1307, USA.
337    
338     =head1 CHANGE
339    
340     See F<ChangeLog>.
341 wakaba 1.13 $Date: 2002/06/09 11:08:27 $
342 wakaba 1.1
343     =cut
344    
345     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24