Message/Field/MDNDisposition.pm


=head1 NAME

Message::Field::MDNDisposition --- A perl module for
MDN Disposition: field body [RFC2298]

=cut

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

%REG = %Message::Util::REG;

## Initialize of this class -- called by constructors
  %DEFAULT = (
    -_MEMBERS   => [qw||],
    -_METHODS   => [qw|value|],
    #encoding_after_encode
    #encoding_before_decode
    #field_param_name
    #field_name
    #field_ns
    #format
    #hook_encode_string
    #hook_decode_string
    -output_comment     => 1,
    -use_comment        => 1,
  );


=head1 CONSTRUCTORS

The following methods construct new objects:

=over 4

=cut

sub _init ($;%) {
  my $self = shift;
  my $DEFAULT = Message::Util::make_clone (\%DEFAULT);
  $self->SUPER::_init (%$DEFAULT, @_);
  
  $self->{option}->{value_type}->{disposition_modifier} = [
    'Message::Field::CSV',{
      -use_comment      => 0,
      -value_unsafe_rule        => 'NON_atext',
  }];
  $self->{value} = {};
}

=item $addr = Message::Field::Domain->new ([%options])

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

=cut

## Inherited

=item $addr = Message::Field::Domain->parse ($field-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 (@_);
  ($body, @{$self->{comment}})
    = $self->Message::Util::delete_comment_to_array ($body)
    if $self->{option}->{use_comment};
  my @d;
  $body =~ s{
    ## disposition-mode
      ($REG{atext}+)    ## action-mode
      $REG{FWS} / $REG{FWS}
      ($REG{atext}+)    ## sending-mode
      $REG{FWS} ; $REG{FWS}
    ## disposition-type
      ($REG{atext}+)
    ## disposition-modifier
      (?: $REG{FWS} / $REG{FWS}
          ([\x00-\xFF]*)$
      )?
  }{
    my ($am, $sm, $dt, $dm) = ($1, $2, $3, $4);
    $self->{value}->{action_mode} = $am;
    $self->{value}->{sending_mode} = $sm;
    $self->{value}->{disposition_type} = $dt;
    $self->{value}->{disposition_modifier} = $self->_parse_value
      (disposition_modifier => $dm);
  }gex;
  $self;
}

sub value ($$;$) {
  my $self = shift;
  my ($type, $newvalue) = @_;
  if ($newvalue) {
    if ($type eq 'disposition_modifier') {
      $self->{value}->{ $type } = $self->_parse_value
        ($type => $newvalue);
    } else {
      $self->{value}->{ $type } = $newvalue;
    }
  }
  if (defined wantarray && $type eq 'disposition_modifier') {
    $self->{value}->{ $type } = $self->_parse_value
        ($type => $self->{value}->{ $type });
    return $self->{value}->{ $type };
  }
  $self->{value}->{ $type };
}

sub stringify ($;%) {
  my $self = shift;
  my %o = @_;  my %option = %{$self->{option}};
  for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
  my $s = '';
  my ($at, $st, $dt, $dm) = @{ $self->{value} }{qw/action_type sending_type disposition_type disposition_modifier/};
  $at ||= 'manual-action';
  $st ||= 'MDN-sent-manually';
  $dt ||= 'displayed';
  $s = sprintf '%s/%s; %s%s', $at, $st, $dt, $dm? '/'.$dm: '';
  if ($option{use_comment} && $option{output_comment}) {
    my $c = $self->_comment_stringify;
    $s .= ' ' . $c if $c;
  }
  $s;
}

=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/07/13 09:27:35 $

=cut

1;
1	wakaba	1.1
2			=head1 NAME
3
4			Message::Field::MDNDisposition --- A perl module for
5			MDN Disposition: field body [RFC2298]
6
7			=cut
8
9			package Message::Field::MDNDisposition;
10			use strict;
11			use vars qw(%DEFAULT @ISA %REG $VERSION);
12			$VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
13			require Message::Field::Structured;
14			push @ISA, qw(Message::Field::Structured);
15
16			%REG = %Message::Util::REG;
17
18			## Initialize of this class -- called by constructors
19			%DEFAULT = (
20			-_MEMBERS => [qw\|\|],
21			-_METHODS => [qw\|value\|],
22			#encoding_after_encode
23			#encoding_before_decode
24			#field_param_name
25			#field_name
26			#field_ns
27			#format
28			#hook_encode_string
29			#hook_decode_string
30			-output_comment => 1,
31			-use_comment => 1,
32			);
33
34
35			=head1 CONSTRUCTORS
36
37			The following methods construct new objects:
38
39			=over 4
40
41			=cut
42
43			sub _init ($;%) {
44			my $self = shift;
45			my $DEFAULT = Message::Util::make_clone (\%DEFAULT);
46			$self->SUPER::_init (%$DEFAULT, @_);
47
48			$self->{option}->{value_type}->{disposition_modifier} = [
49			'Message::Field::CSV',{
50			-use_comment => 0,
51			-value_unsafe_rule => 'NON_atext',
52			}];
53			$self->{value} = {};
54			}
55
56			=item $addr = Message::Field::Domain->new ([%options])
57
58			Constructs a new object. You might pass some options as parameters
59			to the constructor.
60
61			=cut
62
63			## Inherited
64
65			=item $addr = Message::Field::Domain->parse ($field-body, [%options])
66
67			Constructs a new object with given field body. You might pass
68			some options as parameters to the constructor.
69
70			=cut
71
72			sub parse ($$;%) {
73			my $class = shift;
74			my $self = bless {}, $class;
75			my $body = shift;
76			$self->_init (@_);
77			($body, @{$self->{comment}})
78			= $self->Message::Util::delete_comment_to_array ($body)
79			if $self->{option}->{use_comment};
80			my @d;
81			$body =~ s{
82			## disposition-mode
83			($REG{atext}+) ## action-mode
84			$REG{FWS} / $REG{FWS}
85			($REG{atext}+) ## sending-mode
86			$REG{FWS} ; $REG{FWS}
87			## disposition-type
88			($REG{atext}+)
89			## disposition-modifier
90			(?: $REG{FWS} / $REG{FWS}
91			([\x00-\xFF]*)$
92			)?
93			}{
94			my ($am, $sm, $dt, $dm) = ($1, $2, $3, $4);
95			$self->{value}->{action_mode} = $am;
96			$self->{value}->{sending_mode} = $sm;
97			$self->{value}->{disposition_type} = $dt;
98			$self->{value}->{disposition_modifier} = $self->_parse_value
99			(disposition_modifier => $dm);
100			}gex;
101			$self;
102			}
103
104			sub value ($$;$) {
105			my $self = shift;
106			my ($type, $newvalue) = @_;
107			if ($newvalue) {
108			if ($type eq 'disposition_modifier') {
109			$self->{value}->{ $type } = $self->_parse_value
110			($type => $newvalue);
111			} else {
112			$self->{value}->{ $type } = $newvalue;
113			}
114			}
115			if (defined wantarray && $type eq 'disposition_modifier') {
116			$self->{value}->{ $type } = $self->_parse_value
117			($type => $self->{value}->{ $type });
118			return $self->{value}->{ $type };
119			}
120			$self->{value}->{ $type };
121			}
122
123			sub stringify ($;%) {
124			my $self = shift;
125			my %o = @_; my %option = %{$self->{option}};
126			for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
127			my $s = '';
128			my ($at, $st, $dt, $dm) = @{ $self->{value} }{qw/action_type sending_type disposition_type disposition_modifier/};
129			$at \|\|= 'manual-action';
130			$st \|\|= 'MDN-sent-manually';
131			$dt \|\|= 'displayed';
132			$s = sprintf '%s/%s; %s%s', $at, $st, $dt, $dm? '/'.$dm: '';
133			if ($option{use_comment} && $option{output_comment}) {
134			my $c = $self->_comment_stringify;
135			$s .= ' ' . $c if $c;
136			}
137			$s;
138			}
139
140			=head1 LICENSE
141
142			Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
143
144			This program is free software; you can redistribute it and/or modify
145			it under the terms of the GNU General Public License as published by
146			the Free Software Foundation; either version 2 of the License, or
147			(at your option) any later version.
148
149			This program is distributed in the hope that it will be useful,
150			but WITHOUT ANY WARRANTY; without even the implied warranty of
151			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
152			GNU General Public License for more details.
153
154			You should have received a copy of the GNU General Public License
155			along with this program; see the file COPYING. If not, write to
156			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
157			Boston, MA 02111-1307, USA.
158
159			=head1 CHANGE
160
161			See F<ChangeLog>.
162			$Date: 2002/07/13 09:27:35 $
163
164			=cut
165
166			1;