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