Message/Field/Subject.pm


=head1 NAME

Message::Field::Subject -- Perl module for Internet
message header C<Subject:> field body

=cut

package Message::Field::Subject;
use strict;
use vars qw(%DEFAULT @ISA %REG $VERSION);
$VERSION=do{my @r=(q$Revision: 1.12 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require Message::Field::Structured;
push @ISA, q(Message::Field::Structured);

%REG = %Message::Util::REG;
        $REG{news_control} = qr/^cmsg$REG{WSP}+/;
        $REG{prefix_fwd} = qr/(?i)(?:Fwd?|Forward)/;
        $REG{prefix_list} = qr/[(\[][A-Za-z0-9._-]+[\x20:-]\d+[)\]]/;
        $REG{M_prefix_list} = qr/[(\[]([A-Za-z0-9._-]+)[\x20:-](\d+)[)\]]/;
        $REG{M_was_subject} = qr/\([Ww][Aa][Ss][:\x09\x20]$REG{FWS}(.+?)$REG{FWS}\)$REG{FWS}$/;
        $REG{message_from_subject} = qr/^$REG{FWS}(?i)Message from \S+$REG{FWS}$/;
        if ($^V gt v5.7.2) {
          $REG{prefix_re} = q/(?i)Re|Sv|Odp
            |\x{8FD4}   ## Hen
          /;
          $REG{prefix_advertisement} = qr/
            (?i)ADV?:
            |[!\x{FF01}] $REG{FWS} \x{5E83}[\x{543F}\x{544A}] $REG{FWS} [!\x{FF01}]
                ## ! kou koku !
            |[!\x{FF01}] $REG{FWS} [\x{9023}\x{F99A}]\x{7D61}\x{65B9}\x{6CD5}\x{7121}\x{3057}? $REG{FWS} [!\x{FF01}]
                ## ! ren raku hou hou nashi !
            |[\x{672A}\x{672B}] [\x09\x0A\x0D\x20\x{3000}]* 
             \x{627F} [\x09\x0A\x0D\x20\x{3000}]* 
             \x{8AFE} [\x09\x0A\x0D\x20\x{3000}]* 
             \x{5E83} [\x09\x0A\x0D\x20\x{3000}]* 
             [\x{543F}\x{544A}] [\x09\x0A\x0D\x20\x{3000}]* [\x{203B}\x{0FBF}]
                ## mi shou daku kou koku *
          /x;
        } else {
          $REG{prefix_re} = qr/(?i)Re|Sv|Odp/;
          $REG{prefix_advertisement} = qr/(?i)ADV?:/;
        }
        $REG{prefix_general} = qr/((?:$REG{prefix_re}|$REG{prefix_fwd})\^?[\[\(]?\d*[\]\)]?[:>]$REG{FWS})+/x;
        $REG{prefix_general_list} = qr/($REG{prefix_general}|$REG{FWS}$REG{prefix_list}$REG{FWS})+/x;

%DEFAULT = (
        -_MEMBERS       => [qw/is list_count list_name news_control was_subject/],
        -_METHODS       => [qw/as_plain_string is list_count list_name 
                               news_control was_subject value value_type/],
        #encoding_after_encode
        #encoding_before_decode
        -format_news_control    => 'cmsg %s',
        -format_prefix_fwd      => 'Fwd: %s',
        -format_prefix_list     => '[%s:%05d] %s',
        -format_prefix_re       => 'Re: %s',
        -format_was_subject     => '%s (was: %s)',
        #field_param_name
        #field_name
        #field_ns
        #format
        #header_default_charset
        #header_default_charset_input
        #hook_encode_string
        #hook_decode_string
        -output_general_prefix  => 1,
        -output_list_prefix     => 0,
        -output_news_control    => 1,
        -output_was_subject     => 1,   ## ["-"] 1*DIGIT
        #parse_all
        -parse_was_subject      => 1,
        -use_general_prefix     => 1,
        -use_list_prefix        => 1,
        -use_message_from_subject       => 0,
        -use_news_control       => 1,
        -use_was_subject        => 1,
        #value_type
);

=head1 CONSTRUCTORS

The following methods construct new objects:

=over 4

=cut

## Initialize of this class -- called by constructors
sub _init ($;%) {
  my $self = shift;
  my %options = @_;
  $self->SUPER::_init (%DEFAULT, %options);
  
  my $fname = $self->{option}->{field_name};
  if ($fname =~ /^x-.subject$/) {
    $self->{option}->{use_list_prefix} = 0 unless defined $options{-use_list_prefix};
    $self->{option}->{use_news_control} = 0 unless defined $options{-use_news_control};
    $self->{option}->{use_message_from_subject} = 0 unless defined $options{-use_message_from_subject};
  }
  
  #$self->{option}->{value_type}->{news_control} = ['Message::Field::UsenetControl',{}, [qw//]];
  $self->{option}->{value_type}->{was_subject} = ['Message::Field::Subject',{},
    [qw/format_news_control format_prefix_fwd format_prefix_re
    format_was_subject output_general_prefix output_list_prefix
    output_news_control output_was_subject parse_was_subject
    use_general_prefix use_list_prefix use_news_control use_was_subject/]];
}

=item $subject = Message::Field::Subject->new ([%options])

Constructs a new C<Message::Field::Subject> object.  You might pass some 
options as parameters to the constructor.

=cut

## Inherited

=item $subject = Message::Field::Subject->parse ($field-body, [%options])

Constructs a new C<Message::Field::Subject> 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 $option = $self->{option};
  if ($option->{use_news_control} && $body =~ s/$REG{news_control}//) {
    $self->{news_control} = $body;
    return $self;
  }
  my $value = '';
    my %s = &{$self->{option}->{hook_decode_string}} ($self,
      $body,
      type => 'text',
      charset   => $option->{encoding_before_decode},
    );
    if ($s{charset}) {  ## Convertion failed
      $self->{_charset} = $s{charset};
      $self->{value} = $s{value};
      return $self;
    } elsif (!$s{success}) {
      $self->{_charset} = $self->{option}->{header_default_charset_input};
      $self->{value} = $s{value};
      return $self;
    }
    $value = $s{value};
  #if (!$option->{parse_all}) {
  #  $self->{value} = $value;
  #  return $self;
  #}
  if ($option->{use_general_prefix}) {
    if ($option->{use_list_prefix} && $value =~ s/^($REG{prefix_general_list})//x) {
      my $prefix = $1;
      $self->{is}->{reply} = 1 if $prefix =~ /$REG{prefix_re}/x;
      $self->{is}->{foward} = 1 if $prefix =~ /$REG{prefix_fwd}/x;
      ($self->{list_name}, $self->{list_count}) = ($1, $2)
        if $prefix =~ /$REG{M_prefix_list}/x;
    } elsif ($value =~ s/^($REG{prefix_general})//x) {
      my $prefix = $1;
      $self->{is}->{reply} = 1 if $prefix =~ /$REG{prefix_re}/x;
      $self->{is}->{foward} = 1 if $prefix =~ /$REG{prefix_fwd}/x;
    }
  } elsif ($option->{use_list_prefix} && $value =~ s/^$REG{FWS}$REG{M_prefix_list}(?:$REG{FWS}$REG{prefix_list})*$REG{FWS}//x) {
    ($self->{list_name}, $self->{list_count}) = ($1, $2);
  }
  if ($option->{use_was_subject} && $value =~ s/$REG{M_was_subject}//) {
    my $was = $1;
    if ($option->{parse_was_subject}) {
      my %option;
      for (keys %$option) {
        $option{ '-'.$_ } = Message::Util::make_clone ($option->{ $_ });
      }
      $self->{was_subject} = ref ($self)->parse ($was, 
        -hook_decode_string => sub { shift; (value => shift, @_) },
        %option);
    } else {
      $self->{was_subject} = $was;
    }
  }
  if ($option->{use_message_from_subject} && $value =~ s/$REG{message_from_subject}//) {
    $self->{is}->{message_from_subject} = 1;
  }
  $self->{value} = $value;
  $self;
}

=back

=head1 METHODS

=over 4

=cut

sub value ($;$) {
  my $self = shift;
  my $v = shift;
  if (defined $v) {
    $self->{value} = $v;
  }
  $self->{value};
}

sub list_name ($) { $_[0]->{list_name} }
sub list_count ($) { $_[0]->{list_count} }

=item $body = $subject->stringify

Retruns subject field body as string.  String is encoded
for message if necessary.

=cut

sub stringify ($;%) {
  my $self = shift;
  my %o = @_; my %option = %{$self->{option}};
  for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
  if ($option{use_news_control} && $option{output_news_control}
      && $self->{news_control}) {
    my $c = $self->{news_control};
    return '' unless length $c;
    return sprintf $option{format_news_control}, $c;
  }
  if ($self->{_charset}) {
    return $self->{value};
  } else {
    my $value = $self->{value};
    if ($option{use_general_prefix} && $option{output_general_prefix}) {
      $value = sprintf $option{format_prefix_re}, $value if $self->{is}->{reply};
      $value = sprintf $option{format_prefix_fwd}, $value if $self->{is}->{foward};
    }
    if ($option{use_list_prefix} && $option{output_list_prefix}) {
      $value = sprintf $option{format_prefix_list},
        $self->{list_name}, $self->{list_count}, $value
        if length $self->{list_name} && defined $self->{list_count};
    }
    if ($option{use_was_subject} && $option{output_was_subject} > 0) {
      my $was;
      if (ref $self->{was_subject}) {
        my %opt = @_;
        $opt{-output_was_subject} = $opt{output_was_subject}
          unless defined $opt{-output_was_subject};
        $opt{-output_was_subject}--;
        $was = $self->{was_subject}->as_plain_string (%opt);
      } elsif (length $self->{was_subject}) {
        $was = $self->{was_subject};
      }
      $value = sprintf $option{format_was_subject}, $value, $was if defined $was;
    }
      my (%e) = &{$option{hook_encode_string}} ($self,
        $value,
        charset => $option{encoding_after_encode},
        current_charset => $option{internal_charset},
        type => 'text',
      );
      return $e{value};
  }
}
*as_string = \&stringify;

=item $body = $subject->as_plain_string

Returns subject field body as string.  Unlike C<stringify>,
retrun string of this method is not encoded (i.e. returned
in internal code).

=cut

sub as_plain_string ($;%) {
  my $self = shift;
  $self->stringify (
    -hook_encode_string => sub { shift; (value => shift, @_) },
    @_,
  );
}


=item $bool = $subject->is ($attribute [=> $bool])

Set/gets attribute value.

Example:

  $isreply = $subject->is ('re');
        ## Strictly, this checks whether start with "Re: " or not.

  $subject->is (foward => 1, re => 0);

=cut

sub is ($@) {
  my $self = shift;
  if (@_ == 1) {
    my $query = shift;
    if ($query eq 'advertisement') {
      return $self->{value} =~ /$REG{prefix_advertisement}/x? 1:0;
    } else {
      return $self->{is}->{ $_[0] };
    }
  }
  while (my ($name, $value) = splice (@_, 0, 2)) {
    $self->{is}->{ $name } = $value;
  }
}

=item $old_subject = $subject->was_subject

Returns I<was: > subject.

=cut

sub was_subject ($) {
  my $self = shift;
  $self->{was_subject} = $self->_parse_all (was => $self->{was_subject})
    if $self->{option}->{parse_all};
  $self->{was_subject};
}

sub news_control ($) {
  my $self = shift;
  $self->{news_control} = $self->_parse_all (was => $self->{news_control})
    if $self->{option}->{parse_all};
  $self->{news_control};
}

=item $clone = $subject->clone ()

Returns a copy of the object.

=cut

## Inherited

=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/11/13 08:08:52 $

=cut

1;
1	wakaba	1.1
2			=head1 NAME
3
4	wakaba	1.5	Message::Field::Subject -- Perl module for Internet
5			message header C<Subject:> field body
6	wakaba	1.1
7			=cut
8
9			package Message::Field::Subject;
10			use strict;
11	wakaba	1.9	use vars qw(%DEFAULT @ISA %REG $VERSION);
12	wakaba	1.13	$VERSION=do{my @r=(q$Revision: 1.12 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
13	wakaba	1.9	require Message::Field::Structured;
14			push @ISA, q(Message::Field::Structured);
15
16			%REG = %Message::Util::REG;
17			$REG{news_control} = qr/^cmsg$REG{WSP}+/;
18	wakaba	1.13	$REG{prefix_fwd} = qr/(?i)(?:Fwd?\|Forward)/;
19	wakaba	1.9	$REG{prefix_list} = qr/[(\[][A-Za-z0-9._-]+[\x20:-]\d+[)\]]/;
20			$REG{M_prefix_list} = qr/[(\[]([A-Za-z0-9._-]+)[\x20:-](\d+)[)\]]/;
21			$REG{M_was_subject} = qr/\([Ww][Aa][Ss][:\x09\x20]$REG{FWS}(.+?)$REG{FWS}\)$REG{FWS}$/;
22			$REG{message_from_subject} = qr/^$REG{FWS}(?i)Message from \S+$REG{FWS}$/;
23	wakaba	1.11	if ($^V gt v5.7.2) {
24	wakaba	1.12	$REG{prefix_re} = q/(?i)Re\|Sv\|Odp
25	wakaba	1.9	\|\x{8FD4} ## Hen
26	wakaba	1.12	/;
27	wakaba	1.9	$REG{prefix_advertisement} = qr/
28			(?i)ADV?:
29			\|[!\x{FF01}] $REG{FWS} \x{5E83}[\x{543F}\x{544A}] $REG{FWS} [!\x{FF01}]
30			## ! kou koku !
31			\|[!\x{FF01}] $REG{FWS} [\x{9023}\x{F99A}]\x{7D61}\x{65B9}\x{6CD5}\x{7121}\x{3057}? $REG{FWS} [!\x{FF01}]
32			## ! ren raku hou hou nashi !
33	wakaba	1.13	\|[\x{672A}\x{672B}] [\x09\x0A\x0D\x20\x{3000}]*
34			\x{627F} [\x09\x0A\x0D\x20\x{3000}]*
35			\x{8AFE} [\x09\x0A\x0D\x20\x{3000}]*
36			\x{5E83} [\x09\x0A\x0D\x20\x{3000}]*
37			[\x{543F}\x{544A}] [\x09\x0A\x0D\x20\x{3000}]* [\x{203B}\x{0FBF}]
38	wakaba	1.9	## mi shou daku kou koku *
39			/x;
40			} else {
41	wakaba	1.13	$REG{prefix_re} = qr/(?i)Re\|Sv\|Odp/;
42	wakaba	1.9	$REG{prefix_advertisement} = qr/(?i)ADV?:/;
43			}
44			$REG{prefix_general} = qr/((?:$REG{prefix_re}\|$REG{prefix_fwd})\^?[\[\(]?\d*[\]\)]?[:>]$REG{FWS})+/x;
45			$REG{prefix_general_list} = qr/($REG{prefix_general}\|$REG{FWS}$REG{prefix_list}$REG{FWS})+/x;
46
47			%DEFAULT = (
48			-_MEMBERS => [qw/is list_count list_name news_control was_subject/],
49	wakaba	1.10	-_METHODS => [qw/as_plain_string is list_count list_name
50			news_control was_subject value value_type/],
51	wakaba	1.9	#encoding_after_encode
52			#encoding_before_decode
53			-format_news_control => 'cmsg %s',
54			-format_prefix_fwd => 'Fwd: %s',
55	wakaba	1.10	-format_prefix_list => '[%s:%05d] %s',
56	wakaba	1.9	-format_prefix_re => 'Re: %s',
57			-format_was_subject => '%s (was: %s)',
58			#field_param_name
59			#field_name
60			#field_ns
61			#format
62			#header_default_charset
63			#header_default_charset_input
64			#hook_encode_string
65			#hook_decode_string
66			-output_general_prefix => 1,
67	wakaba	1.10	-output_list_prefix => 0,
68	wakaba	1.9	-output_news_control => 1,
69			-output_was_subject => 1, ## ["-"] 1*DIGIT
70			#parse_all
71			-parse_was_subject => 1,
72			-use_general_prefix => 1,
73	wakaba	1.10	-use_list_prefix => 1,
74	wakaba	1.9	-use_message_from_subject => 0,
75			-use_news_control => 1,
76			-use_was_subject => 1,
77			#value_type
78			);
79	wakaba	1.1
80	wakaba	1.5	=head1 CONSTRUCTORS
81	wakaba	1.1
82	wakaba	1.9	The following methods construct new objects:
83	wakaba	1.1
84	wakaba	1.5	=over 4
85	wakaba	1.1
86			=cut
87
88	wakaba	1.5	## Initialize of this class -- called by constructors
89			sub _init ($;%) {
90			my $self = shift;
91			my %options = @_;
92			$self->SUPER::_init (%DEFAULT, %options);
93
94	wakaba	1.10	my $fname = $self->{option}->{field_name};
95			if ($fname =~ /^x-.subject$/) {
96			$self->{option}->{use_list_prefix} = 0 unless defined $options{-use_list_prefix};
97			$self->{option}->{use_news_control} = 0 unless defined $options{-use_news_control};
98			$self->{option}->{use_message_from_subject} = 0 unless defined $options{-use_message_from_subject};
99			}
100
101	wakaba	1.9	#$self->{option}->{value_type}->{news_control} = ['Message::Field::UsenetControl',{}, [qw//]];
102			$self->{option}->{value_type}->{was_subject} = ['Message::Field::Subject',{},
103			[qw/format_news_control format_prefix_fwd format_prefix_re
104			format_was_subject output_general_prefix output_list_prefix
105			output_news_control output_was_subject parse_was_subject
106			use_general_prefix use_list_prefix use_news_control use_was_subject/]];
107	wakaba	1.1	}
108
109	wakaba	1.5	=item $subject = Message::Field::Subject->new ([%options])
110	wakaba	1.1
111	wakaba	1.5	Constructs a new C<Message::Field::Subject> object. You might pass some
112			options as parameters to the constructor.
113
114			=cut
115
116			## Inherited
117
118			=item $subject = Message::Field::Subject->parse ($field-body, [%options])
119
120			Constructs a new C<Message::Field::Subject> object with
121			given field body. You might pass some options as parameters to the constructor.
122	wakaba	1.1
123			=cut
124
125			sub parse ($$;%) {
126			my $class = shift;
127	wakaba	1.5	my $self = bless {}, $class;
128	wakaba	1.9	my $body = shift;
129	wakaba	1.5	$self->_init (@_);
130	wakaba	1.9	my $option = $self->{option};
131			if ($option->{use_news_control} && $body =~ s/$REG{news_control}//) {
132			$self->{news_control} = $body;
133	wakaba	1.1	return $self;
134			}
135	wakaba	1.9	my $value = '';
136			my %s = &{$self->{option}->{hook_decode_string}} ($self,
137			$body,
138			type => 'text',
139			charset => $option->{encoding_before_decode},
140			);
141			if ($s{charset}) { ## Convertion failed
142			$self->{_charset} = $s{charset};
143			$self->{value} = $s{value};
144			return $self;
145			} elsif (!$s{success}) {
146			$self->{_charset} = $self->{option}->{header_default_charset_input};
147			$self->{value} = $s{value};
148			return $self;
149	wakaba	1.1	}
150	wakaba	1.9	$value = $s{value};
151			#if (!$option->{parse_all}) {
152			# $self->{value} = $value;
153			# return $self;
154			#}
155			if ($option->{use_general_prefix}) {
156			if ($option->{use_list_prefix} && $value =~ s/^($REG{prefix_general_list})//x) {
157			my $prefix = $1;
158			$self->{is}->{reply} = 1 if $prefix =~ /$REG{prefix_re}/x;
159			$self->{is}->{foward} = 1 if $prefix =~ /$REG{prefix_fwd}/x;
160			($self->{list_name}, $self->{list_count}) = ($1, $2)
161			if $prefix =~ /$REG{M_prefix_list}/x;
162			} elsif ($value =~ s/^($REG{prefix_general})//x) {
163			my $prefix = $1;
164			$self->{is}->{reply} = 1 if $prefix =~ /$REG{prefix_re}/x;
165			$self->{is}->{foward} = 1 if $prefix =~ /$REG{prefix_fwd}/x;
166			}
167			} elsif ($option->{use_list_prefix} && $value =~ s/^$REG{FWS}$REG{M_prefix_list}(?:$REG{FWS}$REG{prefix_list})*$REG{FWS}//x) {
168			($self->{list_name}, $self->{list_count}) = ($1, $2);
169			}
170			if ($option->{use_was_subject} && $value =~ s/$REG{M_was_subject}//) {
171	wakaba	1.5	my $was = $1;
172	wakaba	1.9	if ($option->{parse_was_subject}) {
173			my %option;
174			for (keys %$option) {
175			$option{ '-'.$_ } = Message::Util::make_clone ($option->{ $_ });
176			}
177			$self->{was_subject} = ref ($self)->parse ($was,
178			-hook_decode_string => sub { shift; (value => shift, @_) },
179			%option);
180	wakaba	1.5	} else {
181	wakaba	1.9	$self->{was_subject} = $was;
182	wakaba	1.5	}
183	wakaba	1.9	}
184			if ($option->{use_message_from_subject} && $value =~ s/$REG{message_from_subject}//) {
185			$self->{is}->{message_from_subject} = 1;
186			}
187			$self->{value} = $value;
188	wakaba	1.1	$self;
189			}
190
191	wakaba	1.5	=back
192
193			=head1 METHODS
194
195			=over 4
196
197	wakaba	1.9	=cut
198
199			sub value ($;$) {
200			my $self = shift;
201			my $v = shift;
202			if (defined $v) {
203			$self->{value} = $v;
204			}
205			$self->{value};
206			}
207
208			sub list_name ($) { $_[0]->{list_name} }
209			sub list_count ($) { $_[0]->{list_count} }
210
211	wakaba	1.5	=item $body = $subject->stringify
212
213			Retruns subject field body as string. String is encoded
214			for message if necessary.
215
216			=cut
217
218	wakaba	1.1	sub stringify ($;%) {
219	wakaba	1.9	my $self = shift;
220			my %o = @_; my %option = %{$self->{option}};
221	wakaba	1.5	for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
222	wakaba	1.9	if ($option{use_news_control} && $option{output_news_control}
223			&& $self->{news_control}) {
224			my $c = $self->{news_control};
225			return '' unless length $c;
226			return sprintf $option{format_news_control}, $c;
227	wakaba	1.5	}
228	wakaba	1.9	if ($self->{_charset}) {
229			return $self->{value};
230			} else {
231			my $value = $self->{value};
232			if ($option{use_general_prefix} && $option{output_general_prefix}) {
233			$value = sprintf $option{format_prefix_re}, $value if $self->{is}->{reply};
234			$value = sprintf $option{format_prefix_fwd}, $value if $self->{is}->{foward};
235			}
236	wakaba	1.10	if ($option{use_list_prefix} && $option{output_list_prefix}) {
237			$value = sprintf $option{format_prefix_list},
238			$self->{list_name}, $self->{list_count}, $value
239			if length $self->{list_name} && defined $self->{list_count};
240			}
241	wakaba	1.9	if ($option{use_was_subject} && $option{output_was_subject} > 0) {
242			my $was;
243			if (ref $self->{was_subject}) {
244			my %opt = @_;
245			$opt{-output_was_subject} = $opt{output_was_subject}
246			unless defined $opt{-output_was_subject};
247			$opt{-output_was_subject}--;
248			$was = $self->{was_subject}->as_plain_string (%opt);
249			} elsif (length $self->{was_subject}) {
250			$was = $self->{was_subject};
251			}
252			$value = sprintf $option{format_was_subject}, $value, $was if defined $was;
253			}
254			my (%e) = &{$option{hook_encode_string}} ($self,
255			$value,
256			charset => $option{encoding_after_encode},
257			current_charset => $option{internal_charset},
258			type => 'text',
259			);
260			return $e{value};
261	wakaba	1.5	}
262	wakaba	1.1	}
263	wakaba	1.5	*as_string = \&stringify;
264
265			=item $body = $subject->as_plain_string
266
267			Returns subject field body as string. Unlike C<stringify>,
268			retrun string of this method is not encoded (i.e. returned
269			in internal code).
270
271			=cut
272	wakaba	1.1
273	wakaba	1.3	sub as_plain_string ($;%) {
274	wakaba	1.1	my $self = shift;
275	wakaba	1.9	$self->stringify (
276			-hook_encode_string => sub { shift; (value => shift, @_) },
277			@_,
278			);
279	wakaba	1.8	}
280	wakaba	1.5
281
282	wakaba	1.1
283	wakaba	1.5	=item $bool = $subject->is ($attribute [=> $bool])
284
285			Set/gets attribute value.
286
287			Example:
288
289			$isreply = $subject->is ('re');
290			## Strictly, this checks whether start with "Re: " or not.
291
292			$subject->is (foward => 1, re => 0);
293
294			=cut
295
296			sub is ($@) {
297	wakaba	1.1	my $self = shift;
298	wakaba	1.5	if (@_ == 1) {
299	wakaba	1.9	my $query = shift;
300			if ($query eq 'advertisement') {
301			return $self->{value} =~ /$REG{prefix_advertisement}/x? 1:0;
302			} else {
303			return $self->{is}->{ $_[0] };
304			}
305	wakaba	1.5	}
306			while (my ($name, $value) = splice (@_, 0, 2)) {
307	wakaba	1.9	$self->{is}->{ $name } = $value;
308	wakaba	1.1	}
309			}
310
311	wakaba	1.9	=item $old_subject = $subject->was_subject
312	wakaba	1.5
313			Returns I<was: > subject.
314
315			=cut
316
317	wakaba	1.9	sub was_subject ($) {
318	wakaba	1.1	my $self = shift;
319	wakaba	1.9	$self->{was_subject} = $self->_parse_all (was => $self->{was_subject})
320			if $self->{option}->{parse_all};
321			$self->{was_subject};
322			}
323
324			sub news_control ($) {
325			my $self = shift;
326			$self->{news_control} = $self->_parse_all (was => $self->{news_control})
327			if $self->{option}->{parse_all};
328			$self->{news_control};
329	wakaba	1.1	}
330
331	wakaba	1.5	=item $clone = $subject->clone ()
332
333			Returns a copy of the object.
334
335			=cut
336
337	wakaba	1.9	## Inherited
338	wakaba	1.1
339			=head1 LICENSE
340
341			Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
342
343			This program is free software; you can redistribute it and/or modify
344			it under the terms of the GNU General Public License as published by
345			the Free Software Foundation; either version 2 of the License, or
346			(at your option) any later version.
347
348			This program is distributed in the hope that it will be useful,
349			but WITHOUT ANY WARRANTY; without even the implied warranty of
350			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
351			GNU General Public License for more details.
352
353			You should have received a copy of the GNU General Public License
354			along with this program; see the file COPYING. If not, write to
355			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
356			Boston, MA 02111-1307, USA.
357
358			=head1 CHANGE
359
360			See F<ChangeLog>.
361	wakaba	1.13	$Date: 2002/11/13 08:08:52 $
362	wakaba	1.1
363			=cut
364
365			1;