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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by wakaba, Wed May 29 11:05:53 2002 UTC revision 1.5 by wakaba, Sat Jun 1 05:30:59 2002 UTC
# Line 1  Line 1 
1    
2  =head1 NAME  =head1 NAME
3    
4  Message::Body::TextPlain Perl module  Message::Body::TextPlain --- Perl Module for Internet Media Type "text/plain"
   
 =head1 DESCRIPTION  
   
 Perl module for text/plain media type.  
5    
6  =cut  =cut
7    
8  package Message::Body::TextPlain;  package Message::Body::TextPlain;
9  use strict;  use strict;
10  use vars qw($VERSION %DEFAULT);  use vars qw(%DEFAULT @ISA $VERSION);
11  $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
12    
13    require Message::Field::Structured;
14    push @ISA, qw(Message::Field::Structured);
15  require Message::Header;  require Message::Header;
16  use overload '""' => sub {shift->stringify};  require Message::MIME::Charset;
17    use overload '""' => sub { $_[0]->stringify },
18                 fallback => 1;
19    
20      %DEFAULT = (
21        -_METHODS   => [qw|value|],
22        -_MEDIA_TYPE        => 'text/plain',
23        -_MEMBERS   => [qw|_charset|],
24        -body_default_charset       => 'us-ascii',
25        -body_default_charset_input => 'iso-2022-int-1',
26        #encoding_after_encode
27        #encoding_before_decode
28        -hook_encode_string => \&Message::Util::encode_body_string,
29        -hook_decode_string => \&Message::Util::decode_body_string,
30        -parse_all  => 0,
31        -use_normalization  => 1,
32        -use_param_charset  => 1,
33      );
34    
35    =head1 CONSTRUCTORS
36    
37  %DEFAULT = (  The following methods construct new C<Message::Field::Structured> objects:
   encoding_after_encode => '*default',  
   encoding_before_decode        => '*default',  
   hook_encode_string    => #sub {shift; (value => shift, @_)},  
         \&Message::Util::encode_body_string,  
   hook_decode_string    => #sub {shift; (value => shift, @_)},  
         \&Message::Util::decode_body_string,  
 );  
38    
39  =head2 Message::Body::TextPlain->new ([%option])  =over 4
   
 Returns new Message::Body::TextPlain instance.  Some options can be  
 specified as hash.  
40    
41  =cut  =cut
42    
43  sub new ($;%) {  ## Initialize of this class -- called by constructors
44    my $class = shift;  sub _init ($;%) {
45    my $self = bless {option => {@_}}, $class;    my $self = shift;
46    for (keys %DEFAULT) {$self->{option}->{$_} ||= $DEFAULT{$_}}    my $DEFAULT = Message::Util::make_clone (\%DEFAULT);
47    $self;    my %option = @_;
48      $self->SUPER::_init (%$DEFAULT, %option);
49      
50      if (ref $option{header}) {
51        $self->{header} = $option{header};
52      }
53      if ($self->{option}->{format} =~ /http/) {
54        $self->{option}->{use_normalization} = 0;
55      }
56  }  }
57    
58  =head2 Message::Body::TextPlain->parse ($body, [%option])  =item $body = Message::Body::TextPlain->new ([%options])
59    
60    Constructs a new object.  You might pass some options as parameters
61    to the constructor.
62    
63    =cut
64    
65    ## Inherited
66    
67    =item $body = Message::Body::TextPlain->parse ($body, [%options])
68    
69  Returns a new Message::Body::TextPlain with given body  Constructs a new object with given field body.  You might pass
70  object.  Some options can be specified as hash.  some options as parameters to the constructor.
71    
72  =cut  =cut
73    
74  sub parse ($$;%) {  sub parse ($$;%) {
75    my $class = shift;    my $class = shift;
76      my $self = bless {}, $class;
77    my $body = shift;    my $body = shift;
78    my $self = bless {option => {@_}}, $class;    $self->_init (@_);
79    for (keys %DEFAULT) {$self->{option}->{$_} ||= $DEFAULT{$_}}    my $charset;
80    $self->header ($self->{option}->{header});    my $ct; $ct = $self->{header}->field ('content-type', -new_item_unless_exist => 0)
81    my %s = &{$self->{option}->{hook_decode_string}} ($self, $body, type => 'body');      if ref $self->{header};
82    $self->{body} = $s{value};    $charset = $ct->parameter ('charset') if ref $ct;
83      $charset ||= $self->{option}->{encoding_before_decode};
84      my %s = &{$self->{option}->{hook_decode_string}} ($self, $body,
85        type => 'body', charset => $charset);
86      $self->{value} = $s{value};
87      $self->{_charset} = $s{charset};      ## When convertion failed
88    $self;    $self;
89  }  }
90    
91  =head2 $self->header ([$new_header])  =back
92    
93    =cut
94    
95    =item $body->header ([$new_header])
96    
97    
98  =cut  =cut
# Line 68  sub header ($;$) { Line 102  sub header ($;$) {
102    my $new_header = shift;    my $new_header = shift;
103    if (ref $new_header) {    if (ref $new_header) {
104      $self->{header} = $new_header;      $self->{header} = $new_header;
105    } elsif ($new_header) {    #} elsif ($new_header) {
106      $self->{header} = Message::Header->parse ($new_header);    #  $self->{header} = Message::Header->parse ($new_header);
   }  
   unless ($self->{header}) {  
     $self->{header} = new Message::Header;  
107    }    }
108      #unless ($self->{header}) {
109      #  $self->{header} = new Message::Header;
110      #}
111    $self->{header};    $self->{header};
112  }  }
113    
114  =head2 $self->body ([$new_body])  =item $body->value ([$new_body])
115    
116  Returns C<body> as string unless $new_body.  Returns C<body> as string unless $new_body.
117  Set $new_body instead of current C<body>.  Set $new_body instead of current C<body>.
118    
119  =cut  =cut
120    
121  sub body ($;$) {  sub value ($;$) {
122    my $self = shift;    my $self = shift;
123    my $new_body = shift;    my $new_body = shift;
124    if ($new_body) {    if ($new_body) {
125      $self->{body} = $new_body;      $self->{value} = $new_body;
126    }    }
127    $self->{body};    $self->{value};
128  }  }
129    
130  =head2 $self->stringify ([%option])  =head2 $self->stringify ([%option])
# Line 101  Returns the C<body> as a string. Line 135  Returns the C<body> as a string.
135    
136  sub stringify ($;%) {  sub stringify ($;%) {
137    my $self = shift;    my $self = shift;
138    my %OPT = @_;    my %o = @_;  my %option = %{$self->{option}};
139    my (%e) = &{$self->{option}->{hook_encode_string}} ($self,    for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
140            $self->{body}, type => 'body');    my $ct = $self->{header}->field ('content-type', -new_item_unless_exist => 0)
141    $e{value} .= "\x0D\x0A" unless $e{value} =~ /\x0D\x0A$/;      if ref $self->{header};
142      my %e;
143      unless ($self->{_charset}) {
144        my $charset; $charset = $ct->parameter ('charset') if ref $ct;
145        $charset ||= $self->{option}->{encoding_after_encode};
146        (%e) = &{$self->{option}->{hook_encode_string}} ($self,
147              $self->{value}, type => 'body',
148              charset => $charset);
149        #$e{charset} ||= $self->{option}->{body_default_charset}
150        #  if $self->{option}->{body_default_charset_input}
151        #     ne $self->{option}->{body_default_charset};
152        ## Normalize
153        if ($option{use_normalization}) {
154          if ($Message::MIME::Charset::CHARSET{$charset || '*default'}->{mime_text}) {
155            $e{value} =~ s/\x0D(?!\x0A)/\x0D\x0A/gs;
156            $e{value} =~ s/(?<!\x0D)\x0A/\x0D\x0A/gs;
157            $e{value} .= "\x0D\x0A" unless $e{value} =~ /\x0D\x0A$/s;
158          }
159        }
160      } else {
161        %e = (value => $self->{value}, charset => $self->{_charset});
162      }
163      if (ref $self->{header}) {
164        if ($e{charset}) {
165          unless (ref $ct) {
166            $ct = $self->{header}->field ('content-type');
167            $ct->value ($option{_MEDIA_TYPE});
168          }
169          $ct->replace (charset => $e{charset});
170        } elsif (ref $ct) {
171          $ct->replace (charset => $self->{option}->{body_default_charset});
172        }
173      }
174    $e{value};    $e{value};
175  }  }
176  sub as_string ($;%) {shift->stringify (@_)}  *as_string = \&stringify;
177    
178  =head2 $self->option ($option_name)  =head2 $self->option ($option_name)
179    
# Line 115  Returns/set (new) value of the option. Line 181  Returns/set (new) value of the option.
181    
182  =cut  =cut
183    
184  sub option ($$;$) {  ## Inherited: option, clone
   my $self = shift;  
   my ($name, $newval) = @_;  
   if ($newval) {  
     $self->{option}->{$name} = $newval;  
   }  
   $self->{option}->{$name};  
 }  
   
 sub clone ($) {  
   my $self = shift;  
   my $clone = new Message::Entity;  
   $clone->{body} = Message::Util::make_clone ($self->{body});  
   $clone;  
 }  
185    
186  =head1 SEE ALSO  =head1 SEE ALSO
187    
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24