Message/Field/Unstructured.pm


=head1 NAME

Message::Field::Unstructured Perl module

=head1 DESCRIPTION

Perl module for RFC 822/2822 Unstructured C<field>s.

=cut

package Message::Field::Unstructured;
require 5.6.0;
use strict;
use re 'eval';
use vars qw(%DEFAULT %REG $VERSION);
$VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require Message::Util;
use overload '""' => sub {shift->stringify};

%DEFAULT = (
  encoding_after_encode => '*default',
  encoding_before_decode        => '*default',
  hook_encode_string    => #sub {shift; (value => shift, @_)},
        \&Message::Util::encode_header_string,
  hook_decode_string    => #sub {shift; (value => shift, @_)},
        \&Message::Util::decode_header_string,
);

=head2 Message::Field::Unstructured->new ()

Returns new Unstructured Header Field object.

=cut

sub new ($;%) {
  my $class = shift;
  my $self = bless {option => {@_}}, $class;
  for (keys %DEFAULT) {$self->{option}->{$_} ||= $DEFAULT{$_}}
  $self;
}

=head2 Message::Field::Unstructured->new ($field_body)

Reads and returns Unstructured Header Field object.

=cut

sub parse ($$;%) {
  my $class = shift;
  my $field_body = shift;
  my $self = bless {option => {@_}}, $class;
  for (keys %DEFAULT) {$self->{option}->{$_} ||= $DEFAULT{$_}}
  my %s = &{$self->{option}->{hook_decode_string}} ($self, $field_body,
            type => 'text');
  $self->{field_body} = $s{value};
  $self;
}

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

Returns C<field-body>.

=cut

sub stringify ($;%) {
  my $self = shift;
  my %option = @_;
  my (%e) = &{$self->{option}->{hook_encode_string}} ($self, 
          $self->{field_body}, type => 'text');
  $e{value};
}
sub as_string ($;%) {shift->stringify (@_)}

sub as_plain_string ($;%) {
  shift->{field_body};
}

=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>.

=cut

1;
1	wakaba	1.1
2			=head1 NAME
3
4	wakaba	1.2	Message::Field::Unstructured Perl module
5	wakaba	1.1
6			=head1 DESCRIPTION
7
8	wakaba	1.2	Perl module for RFC 822/2822 Unstructured C<field>s.
9	wakaba	1.1
10			=cut
11
12			package Message::Field::Unstructured;
13			require 5.6.0;
14			use strict;
15			use re 'eval';
16	wakaba	1.3	use vars qw(%DEFAULT %REG $VERSION);
17			$VERSION=do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
18			require Message::Util;
19			use overload '""' => sub {shift->stringify};
20	wakaba	1.1
21	wakaba	1.3	%DEFAULT = (
22			encoding_after_encode => '*default',
23			encoding_before_decode => '*default',
24			hook_encode_string => #sub {shift; (value => shift, @_)},
25			\&Message::Util::encode_header_string,
26			hook_decode_string => #sub {shift; (value => shift, @_)},
27			\&Message::Util::decode_header_string,
28			);
29	wakaba	1.1
30	wakaba	1.3	=head2 Message::Field::Unstructured->new ()
31	wakaba	1.1
32	wakaba	1.3	Returns new Unstructured Header Field object.
33	wakaba	1.1
34			=cut
35
36	wakaba	1.2	sub new ($;%) {
37	wakaba	1.3	my $class = shift;
38			my $self = bless {option => {@_}}, $class;
39			for (keys %DEFAULT) {$self->{option}->{$_} \|\|= $DEFAULT{$_}}
40			$self;
41	wakaba	1.1	}
42
43	wakaba	1.3	=head2 Message::Field::Unstructured->new ($field_body)
44	wakaba	1.1
45	wakaba	1.3	Reads and returns Unstructured Header Field object.
46	wakaba	1.1
47			=cut
48
49	wakaba	1.2	sub parse ($$;%) {
50	wakaba	1.3	my $class = shift;
51	wakaba	1.1	my $field_body = shift;
52	wakaba	1.3	my $self = bless {option => {@_}}, $class;
53			for (keys %DEFAULT) {$self->{option}->{$_} \|\|= $DEFAULT{$_}}
54			my %s = &{$self->{option}->{hook_decode_string}} ($self, $field_body,
55			type => 'text');
56			$self->{field_body} = $s{value};
57	wakaba	1.1	$self;
58			}
59
60	wakaba	1.3	=head2 $self->stringify ([%options])
61
62			Returns C<field-body>.
63
64			=cut
65
66			sub stringify ($;%) {
67	wakaba	1.1	my $self = shift;
68	wakaba	1.3	my %option = @_;
69			my (%e) = &{$self->{option}->{hook_encode_string}} ($self,
70			$self->{field_body}, type => 'text');
71			$e{value};
72	wakaba	1.1	}
73	wakaba	1.3	sub as_string ($;%) {shift->stringify (@_)}
74	wakaba	1.1
75	wakaba	1.3	sub as_plain_string ($;%) {
76			shift->{field_body};
77	wakaba	1.1	}
78
79			=head1 LICENSE
80
81			Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
82
83			This program is free software; you can redistribute it and/or modify
84			it under the terms of the GNU General Public License as published by
85			the Free Software Foundation; either version 2 of the License, or
86			(at your option) any later version.
87
88			This program is distributed in the hope that it will be useful,
89			but WITHOUT ANY WARRANTY; without even the implied warranty of
90			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
91			GNU General Public License for more details.
92
93			You should have received a copy of the GNU General Public License
94			along with this program; see the file COPYING. If not, write to
95			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
96			Boston, MA 02111-1307, USA.
97
98			=head1 CHANGE
99
100			See F<ChangeLog>.
101
102			=cut
103
104			1;