Message/Field/XMoe.pm


=head1 NAME

Message::Field::XMoe --- Perl module for
Internet message C<X-Moe:> field body items

=cut

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

=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 = @_;
  my %DEFAULT = (
    #delete_fws
    #encoding_after_encode
    #encoding_before_decode
    #field_name
    #field_param_name
    #format
    #hook_encode_string
    #hook_decode_string
    #parameter_name_case_sensible
    -parameter_rule     => 'param_free',
    #parameter_value_max_length
    #parse_all
    -use_parameter_extension    => 1,
    -value_default      => 'Moe',
    -value_style        => 'slash',     ## name / slash / at
    #value_type
  );
  $self->SUPER::_init (%DEFAULT, %options);
}

## Initialization for new () method.
#sub _initialize_new ($;%) {
#  my $self = shift;
#}

## Initialization for parse () method.
#sub _initialize_parse ($;%) {
  ## Inherited
#}

=item $moe = Message::Field::XMoe->new ([%options])

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

=cut

## Inherited

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

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

=cut

## Inherited

sub _restore_param ($@) {
  my $self = shift;
  my @p = @_;
  my ($name, $from) = ('', '');
  if ($p[0]->[1]->{is_parameter} == 0) {
    $name = shift (@p)->[0];
    if ($name =~ m#^((?:$REG{quoted_string}|[^\x22\x2F])+)/((?:$REG{quoted_string}|[^\x22])+)$#) {
      ($from, $name) = ($1, $2);
    } elsif ($name =~ m#^((?:$REG{quoted_string}|[^\x22\x40])+)$REG{FWS}\@$REG{FWS}((?:$REG{quoted_string}|[^\x22])+)$#) {
      ($name, $from) = ($1, $2);
    }
    $self->{value} = Message::Util::decode_quoted_string ($self, $name);
    $from = Message::Util::decode_quoted_string ($self, $from) if $from;
    if (length $from) {
      push @p, [of => {value => $from, is_parameter => 1, is_internal => 1}];
    }
  }
  $self->SUPER::_restore_param (@p);
}

sub _save_param ($@) {
  my $self = shift;
  $self->SUPER::__save_param (@_);
}

=back

=head1 METHODS

=over 4

=item $moe->replace ($name => [$value], [$name => $value,...])

Sets new parameter C<value> of $name.

  Example:
    $self->replace (age => 18);
    $self->replace (of => 'Kizuato');

=item $count = $moe->count ()

Returns the number of C<parameter>s.

=item $param-value = $moe->parameter ($name, [$new_value])

Returns given C<name>'ed C<parameter>'s C<value>.

=item $param-name = $moe->parameter_name ($index, [$new_name])

Returns (and set) C<$index>'th C<parameter>'s name.

=item $param-value = $moe->parameter_value ($index, [$new_value])

Returns (and set) C<$index>'th C<parameter>'s value.

=cut

## replace, add, count, parameter, parameter_name, parameter_value: Inherited.
## (add should not be used for these field)

=item $field-body = $moe->stringify ()

Returns C<field-body> as a string.

=cut

sub stringify ($;%) {
  my $self = shift;
  my $param = $self->SUPER::stringify_params (@_);
  my $name = $self->value_as_string || $self->{option}->{value_default};
  if ($self->{option}->{value_style} eq 'slash') {
    my %e = &{$self->{option}->{hook_encode_string}} ($self, 
            $self->parameter ('of') || '', type => 'phrase');
    my $v = Message::Util::quote_unsafe_string ($e{value}, 
          unsafe => 'NON_http_token_wsp');
    $name = $v.'/'.$name if length $v;
  } elsif ($self->{option}->{value_style} eq 'at') {
    my %e = &{$self->{option}->{hook_encode_string}} ($self, 
            $self->parameter ('of') || '', type => 'phrase');
    my $v = Message::Util::quote_unsafe_string ($e{value}, 
          unsafe => 'NON_http_token_wsp');
    $name .= ' @ '.$v if length $v;
  }
  $name.(length $param? '; '.$param: '');
}

sub _stringify_params_check ($$$) {
  my $self = shift;
  my ($name, $value) = @_;
  if ($self->{option}->{value_style} eq 'slash'
   || $self->{option}->{value_style} eq 'at') {
    return 0 if $name eq 'of' && $value->{is_parameter};
  }
  1;
}

sub value ($;$) {
  my $self = shift;
  my $new_value = shift;
  if (defined $new_value) {
    $self->{value} = $new_value;
  }
  $self->{value};
}
sub value_as_string ($) {
  my $self = shift;
  my %e = &{$self->{option}->{hook_encode_string}} ($self, 
            $self->{value}, type => 'phrase');
  Message::Util::quote_unsafe_string ($e{value}, 
          unsafe => 'NON_http_token_wsp');
}

=item $option-value = $moe->option ($option-name)

Gets option value.

=item $moe->option ($option-name, $option-value, ...)

Set option value(s).  You can pass multiple option name-value pair
as parameter when setting.

=cut

## Inherited.

=item $clone = $moe->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/04/21 04:27:42 $

=cut

1;
1	wakaba	1.1
2			=head1 NAME
3
4			Message::Field::XMoe --- Perl module for
5			Internet message C<X-Moe:> field body items
6
7			=cut
8
9			package Message::Field::XMoe;
10			use strict;
11			use vars qw(@ISA %REG $VERSION);
12			$VERSION=do{my @r=(q$Revision: 1.5 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
13			require Message::Field::ValueParams;
14			push @ISA, qw(Message::Field::ValueParams);
15			*REG = \%Message::Field::Params::REG;
16
17			=head1 CONSTRUCTORS
18
19			The following methods construct new objects:
20
21			=over 4
22
23			=cut
24
25			## Initialize of this class -- called by constructors
26			sub _init ($;%) {
27			my $self = shift;
28			my %options = @_;
29			my %DEFAULT = (
30			#delete_fws
31			#encoding_after_encode
32			#encoding_before_decode
33			#field_name
34			#field_param_name
35			#format
36			#hook_encode_string
37			#hook_decode_string
38			#parameter_name_case_sensible
39			-parameter_rule => 'param_free',
40			#parameter_value_max_length
41			#parse_all
42			-use_parameter_extension => 1,
43			-value_default => 'Moe',
44			-value_style => 'slash', ## name / slash / at
45			#value_type
46			);
47			$self->SUPER::_init (%DEFAULT, %options);
48			}
49
50			## Initialization for new () method.
51			#sub _initialize_new ($;%) {
52			# my $self = shift;
53			#}
54
55			## Initialization for parse () method.
56			#sub _initialize_parse ($;%) {
57			## Inherited
58			#}
59
60			=item $moe = Message::Field::XMoe->new ([%options])
61
62			Constructs a new object. You might pass some options as parameters
63			to the constructor.
64
65			=cut
66
67			## Inherited
68
69			=item $moe = Message::Field::XMoe->parse ($field-body, [%options])
70
71			Constructs a new object with given field body. You might pass
72			some options as parameters to the constructor.
73
74			=cut
75
76			## Inherited
77
78			sub _restore_param ($@) {
79			my $self = shift;
80			my @p = @_;
81			my ($name, $from) = ('', '');
82			if ($p[0]->[1]->{is_parameter} == 0) {
83			$name = shift (@p)->[0];
84			if ($name =~ m#^((?:$REG{quoted_string}\|[^\x22\x2F])+)/((?:$REG{quoted_string}\|[^\x22])+)$#) {
85			($from, $name) = ($1, $2);
86			} elsif ($name =~ m#^((?:$REG{quoted_string}\|[^\x22\x40])+)$REG{FWS}\@$REG{FWS}((?:$REG{quoted_string}\|[^\x22])+)$#) {
87			($name, $from) = ($1, $2);
88			}
89			$self->{value} = Message::Util::decode_quoted_string ($self, $name);
90			$from = Message::Util::decode_quoted_string ($self, $from) if $from;
91			if (length $from) {
92			push @p, [of => {value => $from, is_parameter => 1, is_internal => 1}];
93			}
94			}
95			$self->SUPER::_restore_param (@p);
96			}
97
98			sub _save_param ($@) {
99			my $self = shift;
100			$self->SUPER::__save_param (@_);
101			}
102
103			=back
104
105			=head1 METHODS
106
107			=over 4
108
109			=item $moe->replace ($name => [$value], [$name => $value,...])
110
111			Sets new parameter C<value> of $name.
112
113			Example:
114			$self->replace (age => 18);
115			$self->replace (of => 'Kizuato');
116
117			=item $count = $moe->count ()
118
119			Returns the number of C<parameter>s.
120
121			=item $param-value = $moe->parameter ($name, [$new_value])
122
123			Returns given C<name>'ed C<parameter>'s C<value>.
124
125			=item $param-name = $moe->parameter_name ($index, [$new_name])
126
127			Returns (and set) C<$index>'th C<parameter>'s name.
128
129			=item $param-value = $moe->parameter_value ($index, [$new_value])
130
131			Returns (and set) C<$index>'th C<parameter>'s value.
132
133			=cut
134
135			## replace, add, count, parameter, parameter_name, parameter_value: Inherited.
136			## (add should not be used for these field)
137
138			=item $field-body = $moe->stringify ()
139
140			Returns C<field-body> as a string.
141
142			=cut
143
144			sub stringify ($;%) {
145			my $self = shift;
146			my $param = $self->SUPER::stringify_params (@_);
147			my $name = $self->value_as_string \|\| $self->{option}->{value_default};
148			if ($self->{option}->{value_style} eq 'slash') {
149			my %e = &{$self->{option}->{hook_encode_string}} ($self,
150			$self->parameter ('of') \|\| '', type => 'phrase');
151			my $v = Message::Util::quote_unsafe_string ($e{value},
152			unsafe => 'NON_http_token_wsp');
153			$name = $v.'/'.$name if length $v;
154			} elsif ($self->{option}->{value_style} eq 'at') {
155			my %e = &{$self->{option}->{hook_encode_string}} ($self,
156			$self->parameter ('of') \|\| '', type => 'phrase');
157			my $v = Message::Util::quote_unsafe_string ($e{value},
158			unsafe => 'NON_http_token_wsp');
159			$name .= ' @ '.$v if length $v;
160			}
161			$name.(length $param? '; '.$param: '');
162			}
163
164			sub _stringify_params_check ($$$) {
165			my $self = shift;
166			my ($name, $value) = @_;
167			if ($self->{option}->{value_style} eq 'slash'
168			\|\| $self->{option}->{value_style} eq 'at') {
169			return 0 if $name eq 'of' && $value->{is_parameter};
170			}
171			1;
172			}
173
174			sub value ($;$) {
175			my $self = shift;
176			my $new_value = shift;
177			if (defined $new_value) {
178			$self->{value} = $new_value;
179			}
180			$self->{value};
181			}
182			sub value_as_string ($) {
183			my $self = shift;
184			my %e = &{$self->{option}->{hook_encode_string}} ($self,
185			$self->{value}, type => 'phrase');
186			Message::Util::quote_unsafe_string ($e{value},
187			unsafe => 'NON_http_token_wsp');
188			}
189
190			=item $option-value = $moe->option ($option-name)
191
192			Gets option value.
193
194			=item $moe->option ($option-name, $option-value, ...)
195
196			Set option value(s). You can pass multiple option name-value pair
197			as parameter when setting.
198
199			=cut
200
201			## Inherited.
202
203			=item $clone = $moe->clone ()
204
205			Returns a copy of the object.
206
207			=cut
208
209			## Inherited
210
211			=head1 LICENSE
212
213			Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
214
215			This program is free software; you can redistribute it and/or modify
216			it under the terms of the GNU General Public License as published by
217			the Free Software Foundation; either version 2 of the License, or
218			(at your option) any later version.
219
220			This program is distributed in the hope that it will be useful,
221			but WITHOUT ANY WARRANTY; without even the implied warranty of
222			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
223			GNU General Public License for more details.
224
225			You should have received a copy of the GNU General Public License
226			along with this program; see the file COPYING. If not, write to
227			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
228			Boston, MA 02111-1307, USA.
229
230			=head1 CHANGE
231
232			See F<ChangeLog>.
233			$Date: 2002/04/21 04:27:42 $
234
235			=cut
236
237			1;