Message/Body/TextPlain.pm


=head1 NAME

Message::Body::TextPlain --- Perl Module for Internet Media Type "text/plain"

=cut

package Message::Body::TextPlain;
use strict;
use vars qw(%DEFAULT @ISA $VERSION);
$VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

require Message::Body::Text;
push @ISA, qw(Message::Body::Text);

%DEFAULT = (
  -_METHODS     => [qw|value|],
  -_MEMBERS     => [qw|_charset|],
  -body_default_charset => 'us-ascii',
  -body_default_charset_input   => 'iso-2022-int-1',
  #encoding_after_encode
  #encoding_before_decode
  #fill_ct      => 0,
  #hook_encode_string
  #hook_decode_string
  -media_type   => 'text',
  -media_subtype        => 'plain',
  -use_normalization    => 1,
  -use_param_charset    => 1,
);

=head1 CONSTRUCTORS

The following methods construct new C<Message::Field::Structured> objects:

=over 4

=cut

## Initialize of this class -- called by constructors
sub _init ($;%) {
  my $self = shift;
  my $DEFAULT = Message::Util::make_clone (\%DEFAULT);
  my %option = @_;
  $self->SUPER::_init (%$DEFAULT, %option);
  
  unless (defined $self->{option}->{fill_ct}) {
    $self->{option}->{fill_ct} = $self->{option}->{format} =~ /http|mime/;
  }
}

=item $body = Message::Body::TextPlain->new ([%options])

Constructs a new object.  You might pass some options as parameters 
to the constructor.

=cut

## Inherited

=item $body = Message::Body::TextPlain->parse ($body, [%options])

Constructs a new object with given field body.  You might pass 
some options as parameters to the constructor.

=cut

sub parse ($$;%) {
  my $class = shift;
  my $self = bless {}, $class;
  my $body = shift;
  $self->_init (@_);
  my $charset;
  my $ct; $ct = $self->{header}->field ('content-type', -new_item_unless_exist => 0) 
    if ref $self->{header};
  $charset = $ct->parameter ('charset') if ref $ct;
  $charset ||= $self->{option}->{encoding_before_decode};
  my %s = &{$self->{option}->{hook_decode_string}} ($self, $body,
    type => 'body', charset => $charset);
  $self->{value} = $s{value};
  $self->{_charset} = $s{charset};      ## When convertion failed
  $self;
}

=back

=cut

=item $body->header ([$new_header])


=cut

## Inherited

=item $body->value ([$new_body])

Returns C<body> as string unless $new_body.
Set $new_body instead of current C<body>.

=cut

## Inherited

=head2 $self->stringify ([%option])

Returns the C<body> as a string.

=cut

sub stringify ($;%) {
  my $self = shift;
  my %o = @_;  my %option = %{$self->{option}};
  for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
  my $ct = $self->{header}->field ('content-type', -new_item_unless_exist => 0)
    if ref $self->{header};
  my %e;
  unless ($self->{_charset}) {
    my $charset; $charset = $ct->parameter ('charset') if ref $ct;
    $charset ||= $self->{option}->{encoding_after_encode};
    (%e) = &{$self->{option}->{hook_encode_string}} ($self, 
          $self->{value}, type => 'body',
          charset => $charset);
    #$e{charset} ||= $self->{option}->{body_default_charset}
    #  if $self->{option}->{body_default_charset_input}
    #     ne $self->{option}->{body_default_charset};
    ## Normalize
    if ($option{use_normalization}) {
      if ($Message::MIME::Charset::CHARSET{$charset || '*default'}->{mime_text}) {
        $e{value} =~ s/\x0D(?!\x0A)/\x0D\x0A/gs;
        $e{value} =~ s/(?<!\x0D)\x0A/\x0D\x0A/gs;
        #$e{value} .= "\x0D\x0A" unless $e{value} =~ /\x0D\x0A$/s;
      }
    }
  } else {
    %e = (value => $self->{value}, charset => $self->{_charset});
  }
  if (ref $self->{header}) {
    if ($e{charset}) {
      unless (ref $ct) {
        $ct = $self->{header}->field ('content-type');
        $ct->value ($option{media_type}.'/'.$option{media_subtype});
      }
      $ct->replace (charset => $e{charset});
    } elsif (ref $ct) {
      $ct->replace (charset => $self->{option}->{body_default_charset});
    } elsif ($option{fill_ct}) {
      $ct = $self->{header}->field ('content-type');
      $ct->value ($option{media_type}.'/'.$option{media_subtype});
      $ct->replace (Message::MIME::Charset::name_minimumize ($option{body_default_charset} => $e{value}));
    }
  }
  $e{value};
}
*as_string = \&stringify;

## Inherited: option, clone

=head1 SEE ALSO

RFC 822 <urn:ietf:rfc:822>,
RFC 2046 <urn:ietf:rfc:2046>, RFC 2646 <urn:ietf:rfc:2646>.

=head1 LICENSE

Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; see the file COPYING.  If not, write to
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
Boston, MA 02111-1307, USA.

=head1 CHANGE

See F<ChangeLog>.
$Date: 2002/05/29 11:05:53 $

=cut

1;
1
2	=head1 NAME
3
4	Message::Body::TextPlain --- Perl Module for Internet Media Type "text/plain"
5
6	=cut
7
8	package Message::Body::TextPlain;
9	use strict;
10	use vars qw(%DEFAULT @ISA $VERSION);
11	$VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
12
13	require Message::Body::Text;
14	push @ISA, qw(Message::Body::Text);
15
16	%DEFAULT = (
17	-_METHODS => [qw\|value\|],
18	-_MEMBERS => [qw\|_charset\|],
19	-body_default_charset => 'us-ascii',
20	-body_default_charset_input => 'iso-2022-int-1',
21	#encoding_after_encode
22	#encoding_before_decode
23	#fill_ct => 0,
24	#hook_encode_string
25	#hook_decode_string
26	-media_type => 'text',
27	-media_subtype => 'plain',
28	-use_normalization => 1,
29	-use_param_charset => 1,
30	);
31
32	=head1 CONSTRUCTORS
33
34	The following methods construct new C<Message::Field::Structured> 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 $DEFAULT = Message::Util::make_clone (\%DEFAULT);
44	my %option = @_;
45	$self->SUPER::_init (%$DEFAULT, %option);
46
47	unless (defined $self->{option}->{fill_ct}) {
48	$self->{option}->{fill_ct} = $self->{option}->{format} =~ /http\|mime/;
49	}
50	}
51
52	=item $body = Message::Body::TextPlain->new ([%options])
53
54	Constructs a new object. You might pass some options as parameters
55	to the constructor.
56
57	=cut
58
59	## Inherited
60
61	=item $body = Message::Body::TextPlain->parse ($body, [%options])
62
63	Constructs a new object with given field body. You might pass
64	some options as parameters to the constructor.
65
66	=cut
67
68	sub parse ($$;%) {
69	my $class = shift;
70	my $self = bless {}, $class;
71	my $body = shift;
72	$self->_init (@_);
73	my $charset;
74	my $ct; $ct = $self->{header}->field ('content-type', -new_item_unless_exist => 0)
75	if ref $self->{header};
76	$charset = $ct->parameter ('charset') if ref $ct;
77	$charset \|\|= $self->{option}->{encoding_before_decode};
78	my %s = &{$self->{option}->{hook_decode_string}} ($self, $body,
79	type => 'body', charset => $charset);
80	$self->{value} = $s{value};
81	$self->{_charset} = $s{charset}; ## When convertion failed
82	$self;
83	}
84
85	=back
86
87	=cut
88
89	=item $body->header ([$new_header])
90
91
92	=cut
93
94	## Inherited
95
96	=item $body->value ([$new_body])
97
98	Returns C<body> as string unless $new_body.
99	Set $new_body instead of current C<body>.
100
101	=cut
102
103	## Inherited
104
105	=head2 $self->stringify ([%option])
106
107	Returns the C<body> as a string.
108
109	=cut
110
111	sub stringify ($;%) {
112	my $self = shift;
113	my %o = @_; my %option = %{$self->{option}};
114	for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
115	my $ct = $self->{header}->field ('content-type', -new_item_unless_exist => 0)
116	if ref $self->{header};
117	my %e;
118	unless ($self->{_charset}) {
119	my $charset; $charset = $ct->parameter ('charset') if ref $ct;
120	$charset \|\|= $self->{option}->{encoding_after_encode};
121	(%e) = &{$self->{option}->{hook_encode_string}} ($self,
122	$self->{value}, type => 'body',
123	charset => $charset);
124	#$e{charset} \|\|= $self->{option}->{body_default_charset}
125	# if $self->{option}->{body_default_charset_input}
126	# ne $self->{option}->{body_default_charset};
127	## Normalize
128	if ($option{use_normalization}) {
129	if ($Message::MIME::Charset::CHARSET{$charset \|\| '*default'}->{mime_text}) {
130	$e{value} =~ s/\x0D(?!\x0A)/\x0D\x0A/gs;
131	$e{value} =~ s/(?<!\x0D)\x0A/\x0D\x0A/gs;
132	#$e{value} .= "\x0D\x0A" unless $e{value} =~ /\x0D\x0A$/s;
133	}
134	}
135	} else {
136	%e = (value => $self->{value}, charset => $self->{_charset});
137	}
138	if (ref $self->{header}) {
139	if ($e{charset}) {
140	unless (ref $ct) {
141	$ct = $self->{header}->field ('content-type');
142	$ct->value ($option{media_type}.'/'.$option{media_subtype});
143	}
144	$ct->replace (charset => $e{charset});
145	} elsif (ref $ct) {
146	$ct->replace (charset => $self->{option}->{body_default_charset});
147	} elsif ($option{fill_ct}) {
148	$ct = $self->{header}->field ('content-type');
149	$ct->value ($option{media_type}.'/'.$option{media_subtype});
150	$ct->replace (Message::MIME::Charset::name_minimumize ($option{body_default_charset} => $e{value}));
151	}
152	}
153	$e{value};
154	}
155	*as_string = \&stringify;
156
157	## Inherited: option, clone
158
159	=head1 SEE ALSO
160
161	RFC 822 <urn:ietf:rfc:822>,
162	RFC 2046 <urn:ietf:rfc:2046>, RFC 2646 <urn:ietf:rfc:2646>.
163
164	=head1 LICENSE
165
166	Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
167
168	This program is free software; you can redistribute it and/or modify
169	it under the terms of the GNU General Public License as published by
170	the Free Software Foundation; either version 2 of the License, or
171	(at your option) any later version.
172
173	This program is distributed in the hope that it will be useful,
174	but WITHOUT ANY WARRANTY; without even the implied warranty of
175	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
176	GNU General Public License for more details.
177
178	You should have received a copy of the GNU General Public License
179	along with this program; see the file COPYING. If not, write to
180	the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
181	Boston, MA 02111-1307, USA.
182
183	=head1 CHANGE
184
185	See F<ChangeLog>.
186	$Date: 2002/05/29 11:05:53 $
187
188	=cut
189
190	1;