/[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.8 - (hide annotations) (download)
Mon Apr 22 08:28:20 2002 UTC (22 years, 7 months ago) by wakaba
Branch: MAIN
Changes since 1.7: +5 -2 lines
2002-04-22  wakaba <w@suika.fam.cx>

	* Makefile: New file.
	
	* Received.pm: Reformed.

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24