Message/Field/XFace.pm


=head1 NAME

Message::Field::XFace --- X-Face Internet Message Header Field

=cut

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

=head1 CONSTRUCTORS

The following methods construct new C<Message::Field::Numval> objects:

=over 4

=cut


%DEFAULT = (
  #field_param_name
  #field_name
  #field_ns
  #format
  -line_length  => 50,
);

=head1 CONSTRUCTORS

The following methods construct new objects:

=over 4

=cut

## $self->_init (%options); Initialize of this class -- called by constructors
sub _init ($;%) {
  my $self = shift;
  my %options = @_;
  my $DEFAULT = Message::Util::make_clone (\%DEFAULT);
  $self->SUPER::_init (%$DEFAULT, %options);
}

=item $m = Message::Field::XFace->new ([%options])

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

=cut

## Inherited

=item $m = Message::Field::XFace->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 $fb = shift;
  $self->_init (@_);
  $fb =~ tr/\x00-\x20\x7F-\xFF//d;
  $self->{value} = $fb;
  $self;
}

=back

=head1 METHODS

=over 4

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

Returns or set value.

=cut

sub value ($;$%) {
  my $self = shift;
  my $new_value = shift;
  if ($new_value) {
    $new_value =~ tr/\x00-\x20\x7F-\xFF//d;
    $self->{value} = $new_value;
  }
  $self->{value};
}

=item $self->stringify ()

Returns C<field-body> as a string.

=cut

sub stringify ($;%) {
  my $self = shift;
  my %o = @_;  my %option = %{$self->{option}};
  for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
  my $s = $self->{value};
  my @s;
  my $l = $option{line_length} - length $option{field_name};
  push @s, substr ($s, 0, $l);
  while (push @s, substr ($s, $l, $option{line_length})) {
    last if $l > length $s;
    $l += $option{line_length};
  }
  join ' ', @s;
}
*as_string = \&stringify;

=back

=over 4

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

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

=cut

## Inherited

=item $self->clone ()

Returns a copy of the object.

=cut

## Inherited

=back

=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/22 08:28:20 $

=cut

1;
1	wakaba	1.1
2			=head1 NAME
3
4			Message::Field::XFace --- X-Face Internet Message Header Field
5
6			=cut
7
8			package Message::Field::XFace;
9			use strict;
10			use vars qw(%DEFAULT @ISA $VERSION);
11			$VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
12			require Message::Util;
13			require Message::Field::Structured;
14			push @ISA, qw(Message::Field::Structured);
15
16			=head1 CONSTRUCTORS
17
18			The following methods construct new C<Message::Field::Numval> objects:
19
20			=over 4
21
22			=cut
23
24
25			%DEFAULT = (
26			#field_param_name
27			#field_name
28			#field_ns
29			#format
30			-line_length => 50,
31			);
32
33			=head1 CONSTRUCTORS
34
35			The following methods construct new objects:
36
37			=over 4
38
39			=cut
40
41			## $self->_init (%options); Initialize of this class -- called by constructors
42			sub _init ($;%) {
43			my $self = shift;
44			my %options = @_;
45			my $DEFAULT = Message::Util::make_clone (\%DEFAULT);
46			$self->SUPER::_init (%$DEFAULT, %options);
47			}
48
49			=item $m = Message::Field::XFace->new ([%options])
50
51			Constructs a new object. You might pass some options as parameters
52			to the constructor.
53
54			=cut
55
56			## Inherited
57
58			=item $m = Message::Field::XFace->parse ($field-body, [%options])
59
60			Constructs a new object with given field body. You might pass
61			some options as parameters to the constructor.
62
63			=cut
64
65			sub parse ($$;%) {
66			my $class = shift;
67			my $self = bless {}, $class;
68			my $fb = shift;
69			$self->_init (@_);
70			$fb =~ tr/\x00-\x20\x7F-\xFF//d;
71			$self->{value} = $fb;
72			$self;
73			}
74
75			=back
76
77			=head1 METHODS
78
79			=over 4
80
81			=item $self->value ([$new_value])
82
83			Returns or set value.
84
85			=cut
86
87			sub value ($;$%) {
88			my $self = shift;
89			my $new_value = shift;
90			if ($new_value) {
91			$new_value =~ tr/\x00-\x20\x7F-\xFF//d;
92			$self->{value} = $new_value;
93			}
94			$self->{value};
95			}
96
97			=item $self->stringify ()
98
99			Returns C<field-body> as a string.
100
101			=cut
102
103			sub stringify ($;%) {
104			my $self = shift;
105			my %o = @_; my %option = %{$self->{option}};
106			for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
107			my $s = $self->{value};
108			my @s;
109			my $l = $option{line_length} - length $option{field_name};
110			push @s, substr ($s, 0, $l);
111			while (push @s, substr ($s, $l, $option{line_length})) {
112			last if $l > length $s;
113			$l += $option{line_length};
114			}
115			join ' ', @s;
116			}
117			*as_string = \&stringify;
118
119			=back
120
121			=over 4
122
123			=item $self->option ( $option-name / $option-name, $option-value, ...)
124
125			Set/gets option value(s). You can pass multiple option name-value pair
126			as parameter when setting.
127
128			=cut
129
130			## Inherited
131
132			=item $self->clone ()
133
134			Returns a copy of the object.
135
136			=cut
137
138			## Inherited
139
140			=back
141
142			=head1 LICENSE
143
144			Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
145
146			This program is free software; you can redistribute it and/or modify
147			it under the terms of the GNU General Public License as published by
148			the Free Software Foundation; either version 2 of the License, or
149			(at your option) any later version.
150
151			This program is distributed in the hope that it will be useful,
152			but WITHOUT ANY WARRANTY; without even the implied warranty of
153			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
154			GNU General Public License for more details.
155
156			You should have received a copy of the GNU General Public License
157			along with this program; see the file COPYING. If not, write to
158			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
159			Boston, MA 02111-1307, USA.
160
161			=head1 CHANGE
162
163			See F<ChangeLog>.
164			$Date: 2002/04/22 08:28:20 $
165
166			=cut
167
168			1;