/[suikacvs]/messaging/manakai/lib/Message/Header/RFC822.pm
Suika

Contents of /messaging/manakai/lib/Message/Header/RFC822.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (hide annotations) (download)
Sat Jul 27 04:43:03 2002 UTC (22 years, 4 months ago) by wakaba
Branch: MAIN
Changes since 1.10: +31 -2 lines
2002-07-26  Wakaba <w@suika.fam.cx>

	* Default.pm (sort_good_practice): New.
	* Default.pm, RFC822.pm, HTTP.pm: Support good-practice order
	sorting.

1 wakaba 1.1
2     =head1 NAME
3    
4     Message::Header::RFC822 --- Internet Messages -- Definition
5     for RFC822 Namespaces of Header Fields
6    
7     =cut
8    
9     package Message::Header::RFC822;
10     use strict;
11     use vars qw($VERSION);
12 wakaba 1.11 $VERSION=do{my @r=(q$Revision: 1.10 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
13 wakaba 1.1 require Message::Header::Default;
14    
15     our %OPTION = %Message::Header::Default::OPTION;
16     $OPTION{namespace_uri} = 'urn:x-suika-fam-cx:msgpm:header:mail:rfc822';
17 wakaba 1.7 $OPTION{namespace_phname} = 'x-rfc822';
18     $OPTION{namespace_phname_goodcase} = 'X-RFC822';
19 wakaba 1.1
20     $OPTION{case_sensible} = 0;
21    
22 wakaba 1.11 $OPTION{field_sort} = {qw/alphabetic 1 good-practice 1/};
23     $OPTION{field_sort_good_practice_order} = {};
24     {
25     my $i = 1;
26     for (
27     qw/mail-from x-envelope-from x-envelope-to resent- path/,
28     qw/return-path received date from subject sender to cc bcc/, ## Recommended by RFC 822
29     qw/message-id in-reply-to references keywords comments encrypted/, ## RFC 822 BNF order
30     ) {
31     $OPTION{field_sort_good_practice_order}->{$_} = $i++;
32     }
33     ## default = 999
34     $i = 1000;
35     for (qw/list- mime-version content- xref/) {
36     $OPTION{field_sort_good_practice_order}->{$_} = $i++;
37     }
38     }
39    
40 wakaba 1.1 $OPTION{goodcase} = {
41     fax => 'FAX',
42     'pics-label' => 'PICS-Label',
43     'list-url' => 'List-URL',
44     'list-id' => 'List-ID',
45     'message-id' => 'Message-ID',
46     'mime-version' => 'MIME-Version',
47     'nic' => 'NIC',
48     'nntp-posting-date' => 'NNTP-Posting-Date',
49     'nntp-posting-host' => 'NNTP-Posting-Host',
50     url => 'URL',
51 wakaba 1.10 'x-cc-sender' => 'X-CC-Sender',
52 wakaba 1.1 'x-dearfriend' => 'X-DearFriend',
53     'x-jsmail-priority' => 'X-JsMail-Priority',
54     'x-mime-autoconverted' => 'X-MIME-Autoconverted',
55     'x-mimeole' => 'X-MimeOLE',
56 wakaba 1.3 'x-ml-count' => 'X-ML-Count',
57     'x-ml-info' => 'X-ML-Info',
58     'x-ml-name' => 'X-ML-Name',
59 wakaba 1.10 'x-mlserver' => 'X-MLServer',
60 wakaba 1.1 'x-msmail-priority' => 'X-MSMail-Priority',
61     'x-nntp-posting-date' => 'X-NNTP-Posting-Date',
62     'x-nntp-posting-host' => 'X-NNTP-Posting-Host',
63     'x-uidl' => 'X-UIDL',
64     'x-uri' => 'X-URI',
65     'x-url' => 'X-URL',
66     };
67     $OPTION{to_be_goodcase} = \&_goodcase;
68    
69     $OPTION{value_type} = {
70     ':default' => ['Message::Field::Unstructured'],
71    
72     date => ['Message::Field::Date'],
73    
74     received => ['Message::Field::Received'],
75     'x-received' => ['Message::Field::Received'],
76    
77     archive => ['Message::Field::ValueParams'],
78     'auto-submitted' => ['Message::Field::ValueParams'],
79     'injector-info' => ['Message::Field::ValueParams'],
80     p3p => ['Message::Field::Params'],
81     'posted-and-mailed' => ['Message::Field::ValueParams'],
82     'x-face-type' => ['Message::Field::ValueParams'],
83     'x-mozilla-draft-info' => ['Message::Field::ValueParams'],
84    
85     ## A message id
86     'message-id' => ['Message::Field::MsgID'],
87    
88     ## Numeric value
89     lines => ['Message::Field::Numval'],
90     'max-forwards' => ['Message::Field::Numval'],
91     'mime-version' => ['Message::Field::Numval'],
92     'x-jsmail-priority' => ['Message::Field::Numval'],
93     'x-mail-count' => ['Message::Field::Numval'],
94     'x-ml-count' => ['Message::Field::Numval'],
95     'x-priority' => ['Message::Field::Numval'],
96    
97     path => ['Message::Field::Path'],
98     'user-agent' => ['Message::Field::UA'],
99 wakaba 1.3 'x-shimbun-agent' => ['Message::Field::UA'],
100 wakaba 1.1
101     subject => ['Message::Field::Subject'],
102     'x-nsubject' => ['Message::Field::Subject'],
103    
104 wakaba 1.4 'x-face' => ['Message::Field::XFace'],
105 wakaba 1.1 };
106     for (qw(cancel-lock disposition-notification-options encoding
107     importance pics-label precedence message-type
108 wakaba 1.4 priority x-list-id sensitivity x-msmail-priority xref))
109 wakaba 1.1 {$OPTION{value_type}->{$_} = ['Message::Field::Structured']}
110     for (qw(abuse-reports-to apparently-to approved approved-by bcc cc complaints-to
111     delivered-to disposition-notification-to envelope-to
112     errors-to from mail-copies-to mail-followup-to mail-reply-to
113     notice-requested-upon-delivery-to read-receipt-to register-mail-reply-requested-by
114     reply-to return-path
115     return-receipt-to return-receipt-requested-to sender to x-abuse-reports-to
116 wakaba 1.10 x-admin x-approved x-beenthere x-biglobe-sender x-cc-sender x-confirm-reading-to
117 wakaba 1.1 x-complaints-to x-envelope-from x-envelope-sender
118     x-envelope-to x-ml-address x-ml-command x-ml-to x-nfrom x-nto
119     x-rcpt-to x-sender x-x-sender))
120     {$OPTION{value_type}->{$_} = ['Message::Field::Addresses']}
121     for (qw(client-date date date-received delivery-date expires
122     expire-date nntp-posting-date posted posted-date received-date
123 wakaba 1.5 reply-by resent-date x-originalarrivaltime x-original-date x-tcup-date))
124 wakaba 1.1 {$OPTION{value_type}->{$_} = ['Message::Field::Date']}
125     for (qw(article-updates in-reply-to
126     obsoletes references replaces see-also supersedes))
127     {$OPTION{value_type}->{$_} = ['Message::Field::MsgIDs']}
128     for (qw(encrypted followup-to keywords uri newsgroups posted-to))
129     {$OPTION{value_type}->{$_} = ['Message::Field::CSV']}
130     for (qw(x-brother x-boss x-classmate x-daughter x-dearfriend x-favoritesong
131     x-friend x-me
132     x-moe x-respect
133     x-sublimate x-son x-sister x-wife))
134     {$OPTION{value_type}->{$_} =[ 'Message::Field::CSV']} ## NOT M::F::XMOE!
135     for (qw(url x-home-page x-http_referer
136     x-info x-pgp-key x-ml-url x-uri x-url x-web))
137     {$OPTION{value_type}->{$_} = ['Message::Field::URI']}
138    
139     $OPTION{uri_mailto_safe} = {
140     ## 1 all (no check) 2 no trace & bcc & from
141     ## 3 no sender's info 4 (default) (currently not used)
142     ## 5 only a few
143     ':default' => 4,
144     'cc' => 5,
145     'bcc' => 1,
146     'body' => 1, ## Not entity body, but "body:" field.
147     'comments' => 5,
148     'date' => 1,
149     'from' => 1,
150     'keywords' => 5,
151     'list-id' => 1,
152     'mail-from' => 1,
153     'message-id' => 1,
154     'mime-version' => 1,
155     'received' => 1,
156     'return-path' => 1,
157     'sender' => 1,
158     'subject' => 5,
159     'summary' => 5,
160     'to' => 5,
161     'user-agent' => 3,
162     'x-face' => 2,
163     'x-mailer' => 3,
164     'x-nsubject' => 5,
165     'x-received' => 1,
166     'x400-received' => 1,
167     };
168    
169 wakaba 1.6 $OPTION{field}->{bcc} = {
170     empty_body => 1,
171     };
172     $OPTION{field}->{'incomplete-copy'} = { ## RFC 2156
173     empty_body => 1,
174     };
175    
176 wakaba 1.1 $Message::Header::NS_phname2uri{$OPTION{namespace_phname}} = $OPTION{namespace_uri};
177     $Message::Header::NS_uri2phpackage{$OPTION{namespace_uri}} = __PACKAGE__;
178    
179     ## $self->_goodcase ($namespace_package_name, $field_name, \%option)
180     sub _goodcase ($$$\%) {
181     no strict 'refs';
182     my $self = shift;
183     my ($nspack, $name, $option) = @_;
184     return $name if $option->{format} =~ /uri-url-mailto/;
185     if ($option->{format} =~ /mail-rfc822/) {
186     if ($name eq 'cc' || $name eq 'bcc') {
187     return $name;
188     }
189     }
190     if (${$nspack.'::OPTION'}{goodcase}->{$name}) {
191     return ${$nspack.'::OPTION'}{goodcase}->{$name};
192     }
193     $name =~ s/(?:^|-)[a-z]/uc $&/ge;
194     $name;
195     }
196    
197     package Message::Header::RFC822::Resent;
198     our %OPTION = %Message::Header::RFC822::OPTION;
199     $OPTION{namespace_uri} = 'urn:x-suika-fam-cx:msgpm:header:mail:rfc822:resent';
200 wakaba 1.7 $OPTION{namespace_phname} = 'x-rfc822-resent';
201     $OPTION{namespace_phname_goodcase} = 'X-RFC822-Resent';
202 wakaba 1.1 $OPTION{namespace_phname_regex} = 'resent';
203    
204     $OPTION{uri_mailto_safe} = {
205     ':default' => 1,
206     };
207    
208     $Message::Header::NS_phname2uri{$OPTION{namespace_phname}} = $OPTION{namespace_uri};
209     $Message::Header::NS_uri2phpackage{$OPTION{namespace_uri}} = __PACKAGE__;
210    
211     package Message::Header::RFC822::Original;
212     our %OPTION = %Message::Header::RFC822::OPTION;
213     $OPTION{namespace_uri} = 'urn:x-suika-fam-cx:msgpm:header:mail:rfc822:original';
214 wakaba 1.7 $OPTION{namespace_phname} = 'x-rfc822-original';
215     $OPTION{namespace_phname_goodcase} = 'X-RFC822-Original';
216 wakaba 1.1
217 wakaba 1.6 $OPTION{value_type} = { %{ $OPTION{value_type} } };
218 wakaba 1.9 $OPTION{value_type}->{recipient} = ['Message::Field::TypedText',{
219     -separator => ';',
220     }];
221 wakaba 1.1
222     $OPTION{uri_mailto_safe} = {
223     ':default' => 1,
224     };
225    
226     $Message::Header::NS_phname2uri{$OPTION{namespace_phname}} = $OPTION{namespace_uri};
227     $Message::Header::NS_uri2phpackage{$OPTION{namespace_uri}} = __PACKAGE__;
228    
229     package Message::Header::RFC822::Content;
230     our %OPTION = %Message::Header::RFC822::OPTION;
231     $OPTION{namespace_uri} = 'urn:x-suika-fam-cx:msgpm:header:mail:rfc822:content';
232     $OPTION{namespace_phname} = 'content';
233     $OPTION{namespace_phname_goodcase} = 'Content';
234     $OPTION{namespace_phname_regex} = 'content';
235    
236 wakaba 1.11 $OPTION{field_sort} = {qw/alphabetic 1 good-practice 1/};
237     $OPTION{field_sort_good_practice_order} = {};
238     {
239     my $i = 1;
240     for (
241     qw/type transfer-encoding id description/, ## RFC 2045 BNF order
242     ) {
243     $OPTION{field_sort_good_practice_order}->{$_} = $i++;
244     }
245     }
246    
247 wakaba 1.1 $OPTION{goodcase} = {
248     'id' => 'ID',
249     'md5' => 'MD5',
250     'sgml-entity' => 'SGML-Entity',
251     };
252    
253     $OPTION{value_type} = {
254     ':default' => ['Message::Field::Unstructured'],
255     alias => ['Message::Field::URI'],
256     base => ['Message::Field::URI'],
257     disposition => ['Message::Field::ValueParams'],
258     duration => ['Message::Field::Numval'],
259     encoding => ['Message::Field::CSV'],
260     features => ['Message::Field::Structured'],
261     id => ['Message::Field::MsgID'],
262     language => ['Message::Field::CSV'],
263     length => ['Message::Field::Numval'],
264     location => ['Message::Field::URI'],
265 wakaba 1.8 md5 => ['Message::Field::ValueParams',{
266     -parameter_av_Mrule => 'M_parameter_avpair',
267     -value_unsafe_rule => 'NON_base64alphabet',
268     }],
269 wakaba 1.1 range => ['Message::Field::Structured'],
270     'script-type' => ['Message::Field::ContentType'],
271     'style-type' => ['Message::Field::ContentType'],
272     'transfer-encoding' => ['Message::Field::ValueParams'],
273     type => ['Message::Field::ContentType'],
274 wakaba 1.8 version => ['Message::Field::ValueParams'],
275 wakaba 1.3 'x-properties' => ['Message::Field::Params'],
276 wakaba 1.1 };
277    
278     $OPTION{uri_mailto_safe} = {
279     ':default' => 1,
280     };
281    
282     $Message::Header::NS_phname2uri{$OPTION{namespace_phname}} = $OPTION{namespace_uri};
283     $Message::Header::NS_uri2phpackage{$OPTION{namespace_uri}} = __PACKAGE__;
284    
285     package Message::Header::RFC822::List;
286     our %OPTION = %Message::Header::RFC822::OPTION;
287     $OPTION{namespace_uri} = 'urn:x-suika-fam-cx:msgpm:header:mail:rfc822:list';
288 wakaba 1.7 $OPTION{namespace_phname} = 'x-rfc822-list';
289     $OPTION{namespace_phname_goodcase} = 'X-RFC822-List';
290 wakaba 1.1
291     $OPTION{goodcase} = {
292     'id' => 'ID',
293     };
294    
295     $OPTION{value_type} = {
296     ':default' => ['Message::Field::Unstructured'],
297    
298 wakaba 1.4 id => ['Message::Field::ListID'],
299 wakaba 1.1 software => ['Message::Field::UA'],
300    
301     archive => ['Message::Field::CSV'],
302     digest => ['Message::Field::CSV'],
303     help => ['Message::Field::CSV'],
304     owner => ['Message::Field::CSV'],
305     post => ['Message::Field::CSV'],
306     subscribe => ['Message::Field::CSV'],
307     unsubscribe => ['Message::Field::CSV'],
308     url => ['Message::Field::CSV'],
309     };
310    
311     $OPTION{uri_mailto_safe} = {
312     ':default' => 1,
313     };
314    
315     $Message::Header::NS_phname2uri{$OPTION{namespace_phname}} = $OPTION{namespace_uri};
316     $Message::Header::NS_uri2phpackage{$OPTION{namespace_uri}} = __PACKAGE__;
317    
318     =head1 LICENSE
319    
320     Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
321    
322     This program is free software; you can redistribute it and/or modify
323     it under the terms of the GNU General Public License as published by
324     the Free Software Foundation; either version 2 of the License, or
325     (at your option) any later version.
326    
327     This program is distributed in the hope that it will be useful,
328     but WITHOUT ANY WARRANTY; without even the implied warranty of
329     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
330     GNU General Public License for more details.
331    
332     You should have received a copy of the GNU General Public License
333     along with this program; see the file COPYING. If not, write to
334     the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
335     Boston, MA 02111-1307, USA.
336    
337     =head1 CHANGE
338    
339     See F<ChangeLog>.
340 wakaba 1.11 $Date: 2002/07/19 11:49:46 $
341 wakaba 1.1
342     =cut
343    
344     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24