Message/Field/ValueParams.pm


=head1 NAME

Message::Field::ValueParams Perl module

=head1 DESCRIPTION

Perl module for "word; parameter(s)" style field body.

=cut

package Message::Field::ValueParams;
use strict;
BEGIN {
  no strict;
  use base Message::Field::Params;
  use vars qw(%DEFAULT %REG $VERSION);
}
$VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};

%REG = %Message::Field::Params::REG;

%DEFAULT = (
  use_parameter_extension       => 1,
  value_default => '',
  value_no_regex        => qr/(?:$)(?:^)/,
  value_regex   => qr/[\x00-\xFF]+/,
  value_type    => {'*DEFAULT'  => ':none:',
  },
);

=head2 Message::Field::ValueParams->new ([%option])

Returns new Message::Field::ValueParams.  Some options can be given as hash.

=cut

## Inherited

## Initialization for new () method.
sub _initialize_new ($;%) {
  my $self = shift;
  for (keys %DEFAULT) {$self->{option}->{$_} ||= $DEFAULT{$_}}
  $self->{word} = $self->{option}->{value_default};
}

## Initialization for parse () method.
sub _initialize_parse ($;%) {
  my $self = shift;
  for (keys %DEFAULT) {$self->{option}->{$_} ||= $DEFAULT{$_}}
}

=head2 Message::Field::ValueParams->parse ($nantara, [%option])

Parse Message::Field::ValueParams and new ValueParams instance.  
Some options can be given as hash.

=cut

## Inherited

sub _save_param ($@) {
  my $self = shift;
  my @p = @_;
  if ($p[0]->[1]->{is_parameter} == 0) {
    my $type = shift (@p)->[0];
    if ($type && $type !~ /$self->{option}->{value_no_regex}/) {
      $self->{value} = $type;
    } elsif ($type) {
      push @p, ['x-invalid-value' => {value => $type, is_parameter => 1}];
    }
  }
  $self->{value} ||= $self->{option}->{value_default};
  $self->{param} = \@p;
  $self;
}

=head2 $self->replace ($name, $value, [%option]

Sets new parameter C<value> of $name.

  Example:
    $self->add (title => 'foo of bar'); ## title="foo of bar"
    $self->add (subject => 'hogehoge, foo');    ## subject*=''hogehoge%2C%20foo
    $self->add (foo => 'bar', language => 'en') ## foo*='en'bar

This method returns array reference of (name, {value => value, attribute...}).
C<value> is same as returned value of C<$self-E<gt>parameter>.

Available options: charset (charset name), language (language tag),
value (1/0, see example above).

=head2 $self->count ()

Returns the number of C<parameter>.

=head2 $self->parameter ($name, [$new_value])

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

Note that when $self->{option}->{value_type}->{$name}
is defined (and it is class name), returned value
is a reference to the object.

=head2 $self->parameter_name ($index, [$new_name])

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

=head2 $self->parameter_value ($index, [$new_value])

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

Note that when $self->{option}->{value_type}->{$name}
is defined (and it is class name), returned value
is a reference to the object.

=cut

## replace, count, parameter, parameter_name, parameter_value: Inherited.
## add: inherited but should not be used.

## Hook called before returning C<value>.
## $self->_param_value ($name, $value);
sub _param_value ($$$) {
  my $self = shift;
  my $name = shift;
  my $value = shift;
  my $vtype = $self->{option}->{value_type}->{$name}
           || $self->{option}->{value_type}->{'*DEFAULT'};
  if (ref $value) {
    return $value;
  } elsif ($vtype eq ':none:') {
    return $value;
  } elsif ($value) {
    eval "require $vtype";
    return $vtype->parse ($value);
  } else {
    eval "require $vtype";
    return $vtype->new ();
  }
}

=head2 $self->stringify ([%option])

Returns Content-Disposition C<field-body> as a string.

=head2 $self->as_string ([%option])

An alias of C<stringify>.

=cut

sub stringify ($;%) {
  my $self = shift;
  my $param = $self->SUPER::stringify (@_);
  $self->value ().($param? '; '.$param: '');
}

=head2 $self->value ([$new_value])

Returns or set value.

=cut

sub value ($;$) {
  my $self = shift;
  my $new_value = shift;
  if ($new_value && $new_value !~ m#$self->{option}->{value_no_regex}#) {
    $self->{value} = $new_value;
  }
  $self->_quote_unsafe_string ($self->{value});
}


=head2 $self->option ($option_name)

Returns/set (new) value of the option.

=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/03/23 10:41:33 $

=cut

1;
1	wakaba	1.1
2			=head1 NAME
3
4			Message::Field::ValueParams Perl module
5
6			=head1 DESCRIPTION
7
8			Perl module for "word; parameter(s)" style field body.
9
10			=cut
11
12			package Message::Field::ValueParams;
13			use strict;
14			BEGIN {
15			no strict;
16			use base Message::Field::Params;
17			use vars qw(%DEFAULT %REG $VERSION);
18			}
19			$VERSION=do{my @r=(q$Revision: 1.1 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
20
21			%REG = %Message::Field::Params::REG;
22
23			%DEFAULT = (
24			use_parameter_extension => 1,
25			value_default => '',
26			value_no_regex => qr/(?:$)(?:^)/,
27			value_regex => qr/[\x00-\xFF]+/,
28			value_type => {'*DEFAULT' => ':none:',
29			},
30			);
31
32			=head2 Message::Field::ValueParams->new ([%option])
33
34			Returns new Message::Field::ValueParams. Some options can be given as hash.
35
36			=cut
37
38			## Inherited
39
40			## Initialization for new () method.
41			sub _initialize_new ($;%) {
42			my $self = shift;
43			for (keys %DEFAULT) {$self->{option}->{$_} \|\|= $DEFAULT{$_}}
44			$self->{word} = $self->{option}->{value_default};
45			}
46
47			## Initialization for parse () method.
48			sub _initialize_parse ($;%) {
49			my $self = shift;
50			for (keys %DEFAULT) {$self->{option}->{$_} \|\|= $DEFAULT{$_}}
51			}
52
53			=head2 Message::Field::ValueParams->parse ($nantara, [%option])
54
55			Parse Message::Field::ValueParams and new ValueParams instance.
56			Some options can be given as hash.
57
58			=cut
59
60			## Inherited
61
62			sub _save_param ($@) {
63			my $self = shift;
64			my @p = @_;
65			if ($p[0]->[1]->{is_parameter} == 0) {
66			my $type = shift (@p)->[0];
67			if ($type && $type !~ /$self->{option}->{value_no_regex}/) {
68			$self->{value} = $type;
69			} elsif ($type) {
70			push @p, ['x-invalid-value' => {value => $type, is_parameter => 1}];
71			}
72			}
73			$self->{value} \|\|= $self->{option}->{value_default};
74			$self->{param} = \@p;
75			$self;
76			}
77
78			=head2 $self->replace ($name, $value, [%option]
79
80			Sets new parameter C<value> of $name.
81
82			Example:
83			$self->add (title => 'foo of bar'); ## title="foo of bar"
84			$self->add (subject => 'hogehoge, foo'); ## subject*=''hogehoge%2C%20foo
85			$self->add (foo => 'bar', language => 'en') ## foo*='en'bar
86
87			This method returns array reference of (name, {value => value, attribute...}).
88			C<value> is same as returned value of C<$self-E<gt>parameter>.
89
90			Available options: charset (charset name), language (language tag),
91			value (1/0, see example above).
92
93			=head2 $self->count ()
94
95			Returns the number of C<parameter>.
96
97			=head2 $self->parameter ($name, [$new_value])
98
99			Returns given C<name>'ed C<parameter>'s C<value>.
100
101			Note that when $self->{option}->{value_type}->{$name}
102			is defined (and it is class name), returned value
103			is a reference to the object.
104
105			=head2 $self->parameter_name ($index, [$new_name])
106
107			Returns (and set) C<$index>'th C<parameter>'s name.
108
109			=head2 $self->parameter_value ($index, [$new_value])
110
111			Returns (and set) C<$index>'th C<parameter>'s value.
112
113			Note that when $self->{option}->{value_type}->{$name}
114			is defined (and it is class name), returned value
115			is a reference to the object.
116
117			=cut
118
119			## replace, count, parameter, parameter_name, parameter_value: Inherited.
120			## add: inherited but should not be used.
121
122			## Hook called before returning C<value>.
123			## $self->_param_value ($name, $value);
124			sub _param_value ($$$) {
125			my $self = shift;
126			my $name = shift;
127			my $value = shift;
128			my $vtype = $self->{option}->{value_type}->{$name}
129			\|\| $self->{option}->{value_type}->{'*DEFAULT'};
130			if (ref $value) {
131			return $value;
132			} elsif ($vtype eq ':none:') {
133			return $value;
134			} elsif ($value) {
135			eval "require $vtype";
136			return $vtype->parse ($value);
137			} else {
138			eval "require $vtype";
139			return $vtype->new ();
140			}
141			}
142
143			=head2 $self->stringify ([%option])
144
145			Returns Content-Disposition C<field-body> as a string.
146
147			=head2 $self->as_string ([%option])
148
149			An alias of C<stringify>.
150
151			=cut
152
153			sub stringify ($;%) {
154			my $self = shift;
155			my $param = $self->SUPER::stringify (@_);
156			$self->value ().($param? '; '.$param: '');
157			}
158
159			=head2 $self->value ([$new_value])
160
161			Returns or set value.
162
163			=cut
164
165			sub value ($;$) {
166			my $self = shift;
167			my $new_value = shift;
168			if ($new_value && $new_value !~ m#$self->{option}->{value_no_regex}#) {
169			$self->{value} = $new_value;
170			}
171			$self->_quote_unsafe_string ($self->{value});
172			}
173
174
175			=head2 $self->option ($option_name)
176
177			Returns/set (new) value of the option.
178
179			=cut
180
181			## Inherited.
182
183
184			=head1 LICENSE
185
186			Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
187
188			This program is free software; you can redistribute it and/or modify
189			it under the terms of the GNU General Public License as published by
190			the Free Software Foundation; either version 2 of the License, or
191			(at your option) any later version.
192
193			This program is distributed in the hope that it will be useful,
194			but WITHOUT ANY WARRANTY; without even the implied warranty of
195			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
196			GNU General Public License for more details.
197
198			You should have received a copy of the GNU General Public License
199			along with this program; see the file COPYING. If not, write to
200			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
201			Boston, MA 02111-1307, USA.
202
203			=head1 CHANGE
204
205			See F<ChangeLog>.
206			$Date: 2002/03/23 10:41:33 $
207
208			=cut
209
210			1;