/[suikacvs]/messaging/manakai/lib/Message/Body/TextPlain.pm
Suika

Contents of /messaging/manakai/lib/Message/Body/TextPlain.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (hide annotations) (download)
Tue May 14 13:50:11 2002 UTC (22 years, 6 months ago) by wakaba
Branch: MAIN
Changes since 1.2: +9 -2 lines
2002-05-14  wakaba <w@suika.fam.cx>

	* Entity.pm (pod:uri-url-mailto-*): New list-items.
	(stringify): Output mailto: URL when format =~ url-mailto.
	* Header.pm (stringify): Ditto.
	* Util.pm: Bugs are fixed.
	(remove_meaningless_wsp): New function.

1 wakaba 1.1
2     =head1 NAME
3    
4     Message::Body::TextPlain Perl module
5    
6     =head1 DESCRIPTION
7    
8     Perl module for text/plain media type.
9    
10     =cut
11    
12     package Message::Body::TextPlain;
13     use strict;
14     use vars qw($VERSION %DEFAULT);
15 wakaba 1.3 $VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
16 wakaba 1.1
17     require Message::Header;
18     use overload '""' => sub {shift->stringify};
19    
20 wakaba 1.2 %DEFAULT = (
21     encoding_after_encode => '*default',
22     encoding_before_decode => '*default',
23     hook_encode_string => #sub {shift; (value => shift, @_)},
24     \&Message::Util::encode_body_string,
25     hook_decode_string => #sub {shift; (value => shift, @_)},
26     \&Message::Util::decode_body_string,
27     );
28    
29 wakaba 1.1 =head2 Message::Body::TextPlain->new ([%option])
30    
31     Returns new Message::Body::TextPlain instance. Some options can be
32     specified as hash.
33    
34     =cut
35    
36     sub new ($;%) {
37     my $class = shift;
38     my $self = bless {option => {@_}}, $class;
39     for (keys %DEFAULT) {$self->{option}->{$_} ||= $DEFAULT{$_}}
40     $self;
41     }
42    
43     =head2 Message::Body::TextPlain->parse ($body, [%option])
44    
45     Returns a new Message::Body::TextPlain with given body
46     object. Some options can be specified as hash.
47    
48     =cut
49    
50     sub parse ($$;%) {
51     my $class = shift;
52     my $body = shift;
53     my $self = bless {option => {@_}}, $class;
54     for (keys %DEFAULT) {$self->{option}->{$_} ||= $DEFAULT{$_}}
55     $self->header ($self->{option}->{header});
56 wakaba 1.2 my %s = &{$self->{option}->{hook_decode_string}} ($self, $body, type => 'body');
57     $self->{body} = $s{value};
58 wakaba 1.1 $self;
59     }
60    
61     =head2 $self->header ([$new_header])
62    
63    
64     =cut
65    
66     sub header ($;$) {
67     my $self = shift;
68     my $new_header = shift;
69     if (ref $new_header) {
70     $self->{header} = $new_header;
71     } elsif ($new_header) {
72     $self->{header} = Message::Header->parse ($new_header);
73     }
74     unless ($self->{header}) {
75     $self->{header} = new Message::Header;
76     }
77     $self->{header};
78     }
79    
80     =head2 $self->body ([$new_body])
81    
82     Returns C<body> as string unless $new_body.
83     Set $new_body instead of current C<body>.
84    
85     =cut
86    
87     sub body ($;$) {
88     my $self = shift;
89     my $new_body = shift;
90     if ($new_body) {
91     $self->{body} = $new_body;
92     }
93     $self->{body};
94     }
95    
96     =head2 $self->stringify ([%option])
97    
98     Returns the C<body> as a string.
99    
100     =cut
101    
102     sub stringify ($;%) {
103     my $self = shift;
104     my %OPT = @_;
105 wakaba 1.2 my (%e) = &{$self->{option}->{hook_encode_string}} ($self,
106     $self->{body}, type => 'body');
107     $e{value} .= "\n" unless $e{value} =~ /\n$/;
108     $e{value};
109 wakaba 1.1 }
110     sub as_string ($;%) {shift->stringify (@_)}
111    
112     =head2 $self->option ($option_name)
113    
114     Returns/set (new) value of the option.
115    
116     =cut
117    
118     sub option ($$;$) {
119     my $self = shift;
120     my ($name, $newval) = @_;
121     if ($newval) {
122     $self->{option}->{$name} = $newval;
123     }
124     $self->{option}->{$name};
125     }
126    
127 wakaba 1.3 sub clone ($) {
128     my $self = shift;
129     my $clone = new Message::Entity;
130     $clone->{body} = Message::Util::make_clone ($self->{body});
131     $clone;
132     }
133    
134 wakaba 1.1 =head1 SEE ALSO
135    
136     RFC 822 <urn:ietf:rfc:822>,
137     RFC 2046 <urn:ietf:rfc:2046>, RFC 2646 <urn:ietf:rfc:2646>.
138    
139     =head1 LICENSE
140    
141     Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
142    
143     This program is free software; you can redistribute it and/or modify
144     it under the terms of the GNU General Public License as published by
145     the Free Software Foundation; either version 2 of the License, or
146     (at your option) any later version.
147    
148     This program is distributed in the hope that it will be useful,
149     but WITHOUT ANY WARRANTY; without even the implied warranty of
150     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
151     GNU General Public License for more details.
152    
153     You should have received a copy of the GNU General Public License
154     along with this program; see the file COPYING. If not, write to
155     the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
156     Boston, MA 02111-1307, USA.
157    
158     =head1 CHANGE
159    
160     See F<ChangeLog>.
161 wakaba 1.3 $Date: 2002/03/25 10:18:35 $
162 wakaba 1.1
163     =cut
164    
165     1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24