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.3 $=~/\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};
}
=head2 $self->option ($option_name, [$option_value])

Set/gets new value of the option.

=cut

sub option ($$;$) {
  my $self = shift;
  my ($name, $value) = @_;
  if (defined $value) {
    $self->{option}->{$name} = $value;
  }
  $self->{option}->{$name};
}

=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	wakaba	1.4	$VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
18	wakaba	1.3	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.4	}
78			=head2 $self->option ($option_name, [$option_value])
79
80			Set/gets new value of the option.
81
82			=cut
83
84			sub option ($$;$) {
85			my $self = shift;
86			my ($name, $value) = @_;
87			if (defined $value) {
88			$self->{option}->{$name} = $value;
89			}
90			$self->{option}->{$name};
91	wakaba	1.1	}
92
93			=head1 LICENSE
94
95			Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
96
97			This program is free software; you can redistribute it and/or modify
98			it under the terms of the GNU General Public License as published by
99			the Free Software Foundation; either version 2 of the License, or
100			(at your option) any later version.
101
102			This program is distributed in the hope that it will be useful,
103			but WITHOUT ANY WARRANTY; without even the implied warranty of
104			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
105			GNU General Public License for more details.
106
107			You should have received a copy of the GNU General Public License
108			along with this program; see the file COPYING. If not, write to
109			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
110			Boston, MA 02111-1307, USA.
111
112			=head1 CHANGE
113
114			See F<ChangeLog>.
115
116			=cut
117
118			1;