Message/Field/Addresses.pm


=head1 NAME

Message::Field::Addresses --- Perl module for comma separated
Internet mail address list

=cut

package Message::Field::Addresses;
require 5.6.0;
use strict;
use re 'eval';
use vars qw(%DEFAULT @ISA %REG $VERSION);
$VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require Message::Field::CSV;
push @ISA, qw(Message::Field::CSV);
%REG = %Message::Field::CSV::REG;
        $REG{SC_angle_addr} = qr/<(?:$REG{quoted_string}|$REG{domain_literal}|$REG{comment}|[^\x22\x28\x5B\x3E])+>|<>/;
        $REG{SC_group} = qr/:(?:$REG{comment}|$REG{quoted_string}|(??{$REG{SC_group}})|$REG{domain_literal}|$REG{SC_angle_addr}|[^\x22\x28\x5B\x3A\x3E\x3B])*;/;

=head1 CONSTRUCTORS

The following methods construct new objects:

=over 4

=cut

## Initialize of this class -- called by constructors
  %DEFAULT = (
    -_METHODS   => [qw|add count delete item display_name is_group value_type scan
                       comment_add comment_count comment_delete comment_item|],
    -_MEMBERS   => [qw|group_name group_name_comment|],
    -by => 'display-name',      ## Default key for item, delete,...
    -can_have_group     => 1,
    #encoding_after_encode
    #encoding_before_decode
    #field_name
    #field_param_name
    #format
    #hook_encode_string
    #hook_decode_string
    -is_group   => 0,
    #max
    -output_comment     => 1,
    -output_group_name_comment  => 1,
    #parse_all
    -remove_comment     => 0,   ## This option works for PARENT class
    #value_type
  );
sub _init ($;%) {
  my $self = shift;
  my %options = @_;
  my $DEFAULT = Message::Util::make_clone (\%DEFAULT);
  $self->SUPER::_init (%$DEFAULT, %options);
  my (%mailbox, %group);
  
  $self->{option}->{can_have_group} = 0
    if $self->{option}->{field_param_name} eq 'group';
  
  my $field = $self->{option}->{field_name};
  my $format = $self->{option}->{format};
        ## rfc1036 = RFC 1036 + son-of-RFC1036
  if ($field eq 'from' || $field eq 'resent-from') {
    $self->{option}->{can_have_group} = 0;
    $self->{option}->{max} = 1 if $format =~ /rfc1036|http/;
  } elsif ($field eq 'mail-copies-to') {
    $mailbox{-use_keyword} = 1;
  } elsif ($field eq 'reply-to') {
    $self->{option}->{can_have_group} = 0;
    $self->{option}->{max} = 1 if $format =~ /rfc1036/;
  } elsif ($field eq 'approved' || $field eq 'x-approved') {
    $self->{option}->{can_have_group} = 0;
    $self->{option}->{max} = 1 if $format =~ /news-rfc1036/;
  }
  
  $self->{option}->{value_type}->{mailbox} = ['Message::Field::Mailbox',
    {%mailbox}];
  $self->{option}->{value_type}->{group} = ['Message::Field::Addresses',
    {-is_group => 1, %group}];
}

=item $addrs = Message::Field::Addresses->new ([%options])

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

=cut

## Inherited

=item $addrs = Message::Field::Addresses->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 _parse_list ($$) {
  my $self = shift;
  my $fb = shift;
  my @ids;
  if ($self->{option}->{is_group}) {
    $fb =~ s{^((?:$REG{quoted_string}|$REG{comment}|[^\x22\x28\x2C\x3A\x3C\x5B])+):}{
      my ($gname, @gcomment) = Message::Util::delete_comment_to_array ($self, $1);
      $self->{group_name} = Message::Util::decode_quoted_string ($self, $gname);
      $self->{group_name_comment} = \@gcomment;
    ''}gex;
    $fb =~ s{;((?:$REG{comment}|$REG{WSP})*)$}{
      my (undef, @gcomment) = Message::Util::delete_comment_to_array ($self, $1);
      $self->{comment} = \@gcomment;
    ''}gex;
  }
  $fb =~ s{(?:$REG{quoted_string}|$REG{comment}|[^\x22\x28\x2C\x3A\x3C\x5B]|$REG{SC_group}|$REG{SC_angle_addr}|$REG{domain_literal})+}{
    my $s = $&;  $s =~ s/^$REG{WSP}+//;  $s =~ s/$REG{WSP}+$//;
    if ($s =~ /^(?:$REG{quoted_string}|$REG{comment}|[^\x22\x28\x2C\x3A-\x3C\x5B])*:/) {
      $s = $self->_parse_value (group => $s) if $self->{option}->{parse_all};
      $s = {type => 'group', value => $s};
    } else {    ## address or keyword
      $s = $self->_parse_value (mailbox => $s) if $self->{option}->{parse_all};
      $s = {type => 'mailbox', value => $s};
    }
    push @ids, $s;
  }goex;
  @ids;
}

=back

=head1 METHODS

=over 4

=item $addrs->add ({-name => $value}, $addr1, $addr2, $addr3,...)

Adds mail address(es).

First argument is hash reference to name/value pairs
of options.  This is optional.

Following is list of additional items.  Each item
can be given as array reference.  An array reference
is interpreted as [$item-body, $item-option-name => 
$item-option-value, $name => $value,...].
Available item-options are:

=over 2

=item C<group>

Group name which C<$item-body> belongs to.  If there
is no such name of group, new group is created.

=item C<type> = 'mailbox' / 'group' (default 'group')

Format of C<$item-body>.  If 'group' is specified,
<$item-body> is treated as RFC 2822 group.  Otherwise,
it is added as a mailbox.

=back

=item $count = $addrs->count ([%options])

Returns the number of items.  A 'type' option is available.
For example, C<$addrs-E<gt>count (-type =E<gt> 'group')>
returns the number of groups.

=item $addrs->delete ({%options}, $item-key, $key,...)

Deletes items that are matched with (one of) given key.
C<{%options}> is optional.

C<by> option is used to specify what sort of value given keys are.
C<display-name>, the default value, indicates
keys are display-name of items to be removed.

For C<by> option, value C<index> is also available.

C<type> option is also available.  Its value is 'mailbox'
and 'group'.  Default is both of them.

=cut

## add, count, delete: Inherited

sub _add_array_check ($$\%) {
  my $self = shift;
  my ($value, $option) = @_;
  my $value_option = {};
  if (ref $value eq 'ARRAY') {
    ($value, %$value_option) = @$value;
  }
  if (length $value_option->{group}) {
    my $g = $self->item ($value_option->{group}, -type => 'group');
    delete $value_option->{group};
    $g->add (Message::Util::make_clone ($option), [$value, %$value_option]);
    (0);
  } else {
    my $type = $value_option->{type} || 'mailbox';
    $value = $self->_parse_value ($type => $value) if $$option{parse};
    $$option{parse} = 0;
    (1, value => {type => $type, value => $value});
  }
}

sub _delete_match ($$$\%\%) {
  my $self = shift;
  my ($by, $i, $list, $option) = @_;
  return 0 unless ref $$i;  ## Already removed
  return 0 if $$option{type} && $$i->{type} ne $$option{type};
  if ($by eq 'display-name') {
    $$i->{value} = $self->_parse_value ($$i->{type}, $$i->{value});
    return 1 if ref $$i->{value} && $$list{$$i->{value}->display_name};
  } elsif ($by eq 'addr-spec') {
    $$i->{value} = $self->_parse_value ($$i->{type}, $$i->{value});
    return 1 if ref $$i->{value} && $$list{$$i->{value}->addr_spec};
  }
  0;
}
*_item_match = \&_delete_match;

## Returns returned item value    \$item-value, \%option
sub _item_return_value ($\$\%) {
  if (ref ${$_[1]}->{value}) {
    ${$_[1]}->{value};
  } else {
    ${$_[1]}->{value} = $_[0]->_parse_value (${$_[1]}->{type}, ${$_[1]}->{value});
    ${$_[1]}->{value};
  }
}
*_add_return_value = \&_item_return_value;

## Returns returned (new created) item value    $name, \%option
sub _item_new_value ($$\%) {
  my $type = $_[2]->{type} || 'mailbox';
  my $v = $_[0]->_parse_value ($type, '');
  $v->display_name ($_[1]) if ref $v && length $_[1] && $_[2]->{by} eq 'display-name';
  {type => $type, value => $v};
}

sub is_group ($;$) {
  if (defined $_[1]) {
    $_[0]->{option}->{is_group} = $_[1];
  }
  $_[0]->{option}->{is_group};
}

sub have_group ($) {
  my $self = shift;
  for (@{$self->{$self->{option}->{_ARRAY_NAME}}}) {
    return 1 if $_->{type} eq 'group';
  }
  0;
}

sub display_name ($;$) {
  if (defined $_[1]) {
    $_[0]->{group_name} = $_[1];
  }
  $_[0]->{group_name};
}

sub addr_spec ($;%) {
  my $self = shift;
  my @a;
  for (@{$self->{$self->{option}->{_ARRAY_NAME}}}) {
    $_->{value} = $self->_parse_value
      ($_->{type} => $_->{value}) unless ref $_->{value};
    if (ref $_->{value}) {
      push @a, $_->{value}->addr_spec (@_);
    } elsif (length $_->{value}) {
      push @a, $_->{value};
    }
  }
  wantarray? @a: $a[0];
}

## stringify: Inherited
#*as_string = \&stringify;

sub stringify ($;%) {
  my $self = shift;
  my %o = @_;
  my %option = %{$self->{option}};
  for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
  my $m = $self->SUPER::stringify (@_);
  my $g = '';
  if ($option{is_group}) {
    my %s = &{$option{hook_encode_string}} ($self, 
          $self->{group_name}, type => 'phrase');
    $g .= Message::Util::quote_unsafe_string
      ($s{value}, unsafe => 'NON_atext_wsp');
  }
  if ($option{output_comment} && $option{output_group_name_comment}) {
    if (!$option{is_group} && length $self->{group_name}) {
      $g .= ' ('. $self->Message::Util::encode_ccontent ($self->{group_name}) .':)';
    }
    for (@{$self->{group_name_comment}}) {
      $g .= ' ('. $self->Message::Util::encode_ccontent ($_) .')';
    }
  }
  if ($option{is_group}) {
    $m = $g . (length $m? ': ': ':') . $m . ';';
  } else {
    $m = $g . (length $g? ' ': '') . $m;
  }
    if ($option{output_comment} && !$option{output_group_name_comment}) {
      for (@{$self->{group_name_comment}}) {
        $m .= ' ('. $self->Message::Util::encode_ccontent ($_) .')';
      }
    }
    if ($option{output_comment}) {
      for (@{$self->{comment}}) {
        $m .= ' ('. $self->Message::Util::encode_ccontent ($_) .')';
      }
    }
  $m;
}
*as_string = \&stringify;
sub _stringify_item ($$\%) {
  my $self = shift;
  my $item = shift;
  my $option = shift;
  if (!$$option{can_have_group} && ref $item->{value}) {
    $item->{value}->stringify (-is_group => 0);
  } else {
    $item->{value};
  }
}

## option, value_type, clone, method_available: 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/06/09 11:08:27 $

=cut

1;
1
2	=head1 NAME
3
4	Message::Field::Addresses --- Perl module for comma separated
5	Internet mail address list
6
7	=cut
8
9	package Message::Field::Addresses;
10	require 5.6.0;
11	use strict;
12	use re 'eval';
13	use vars qw(%DEFAULT @ISA %REG $VERSION);
14	$VERSION=do{my @r=(q$Revision: 1.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
15	require Message::Field::CSV;
16	push @ISA, qw(Message::Field::CSV);
17	%REG = %Message::Field::CSV::REG;
18	$REG{SC_angle_addr} = qr/<(?:$REG{quoted_string}\|$REG{domain_literal}\|$REG{comment}\|[^\x22\x28\x5B\x3E])+>\|<>/;
19	$REG{SC_group} = qr/:(?:$REG{comment}\|$REG{quoted_string}\|(??{$REG{SC_group}})\|$REG{domain_literal}\|$REG{SC_angle_addr}\|[^\x22\x28\x5B\x3A\x3E\x3B])*;/;
20
21	=head1 CONSTRUCTORS
22
23	The following methods construct new objects:
24
25	=over 4
26
27	=cut
28
29	## Initialize of this class -- called by constructors
30	%DEFAULT = (
31	-_METHODS => [qw\|add count delete item display_name is_group value_type scan
32	comment_add comment_count comment_delete comment_item\|],
33	-_MEMBERS => [qw\|group_name group_name_comment\|],
34	-by => 'display-name', ## Default key for item, delete,...
35	-can_have_group => 1,
36	#encoding_after_encode
37	#encoding_before_decode
38	#field_name
39	#field_param_name
40	#format
41	#hook_encode_string
42	#hook_decode_string
43	-is_group => 0,
44	#max
45	-output_comment => 1,
46	-output_group_name_comment => 1,
47	#parse_all
48	-remove_comment => 0, ## This option works for PARENT class
49	#value_type
50	);
51	sub _init ($;%) {
52	my $self = shift;
53	my %options = @_;
54	my $DEFAULT = Message::Util::make_clone (\%DEFAULT);
55	$self->SUPER::_init (%$DEFAULT, %options);
56	my (%mailbox, %group);
57
58	$self->{option}->{can_have_group} = 0
59	if $self->{option}->{field_param_name} eq 'group';
60
61	my $field = $self->{option}->{field_name};
62	my $format = $self->{option}->{format};
63	## rfc1036 = RFC 1036 + son-of-RFC1036
64	if ($field eq 'from' \|\| $field eq 'resent-from') {
65	$self->{option}->{can_have_group} = 0;
66	$self->{option}->{max} = 1 if $format =~ /rfc1036\|http/;
67	} elsif ($field eq 'mail-copies-to') {
68	$mailbox{-use_keyword} = 1;
69	} elsif ($field eq 'reply-to') {
70	$self->{option}->{can_have_group} = 0;
71	$self->{option}->{max} = 1 if $format =~ /rfc1036/;
72	} elsif ($field eq 'approved' \|\| $field eq 'x-approved') {
73	$self->{option}->{can_have_group} = 0;
74	$self->{option}->{max} = 1 if $format =~ /news-rfc1036/;
75	}
76
77	$self->{option}->{value_type}->{mailbox} = ['Message::Field::Mailbox',
78	{%mailbox}];
79	$self->{option}->{value_type}->{group} = ['Message::Field::Addresses',
80	{-is_group => 1, %group}];
81	}
82
83	=item $addrs = Message::Field::Addresses->new ([%options])
84
85	Constructs a new object. You might pass some options as parameters
86	to the constructor.
87
88	=cut
89
90	## Inherited
91
92	=item $addrs = Message::Field::Addresses->parse ($field-body, [%options])
93
94	Constructs a new object with given field body. You might pass
95	some options as parameters to the constructor.
96
97	=cut
98
99	## Inherited
100
101	sub _parse_list ($$) {
102	my $self = shift;
103	my $fb = shift;
104	my @ids;
105	if ($self->{option}->{is_group}) {
106	$fb =~ s{^((?:$REG{quoted_string}\|$REG{comment}\|[^\x22\x28\x2C\x3A\x3C\x5B])+):}{
107	my ($gname, @gcomment) = Message::Util::delete_comment_to_array ($self, $1);
108	$self->{group_name} = Message::Util::decode_quoted_string ($self, $gname);
109	$self->{group_name_comment} = \@gcomment;
110	''}gex;
111	$fb =~ s{;((?:$REG{comment}\|$REG{WSP})*)$}{
112	my (undef, @gcomment) = Message::Util::delete_comment_to_array ($self, $1);
113	$self->{comment} = \@gcomment;
114	''}gex;
115	}
116	$fb =~ s{(?:$REG{quoted_string}\|$REG{comment}\|[^\x22\x28\x2C\x3A\x3C\x5B]\|$REG{SC_group}\|$REG{SC_angle_addr}\|$REG{domain_literal})+}{
117	my $s = $&; $s =~ s/^$REG{WSP}+//; $s =~ s/$REG{WSP}+$//;
118	if ($s =~ /^(?:$REG{quoted_string}\|$REG{comment}\|[^\x22\x28\x2C\x3A-\x3C\x5B])*:/) {
119	$s = $self->_parse_value (group => $s) if $self->{option}->{parse_all};
120	$s = {type => 'group', value => $s};
121	} else { ## address or keyword
122	$s = $self->_parse_value (mailbox => $s) if $self->{option}->{parse_all};
123	$s = {type => 'mailbox', value => $s};
124	}
125	push @ids, $s;
126	}goex;
127	@ids;
128	}
129
130	=back
131
132	=head1 METHODS
133
134	=over 4
135
136	=item $addrs->add ({-name => $value}, $addr1, $addr2, $addr3,...)
137
138	Adds mail address(es).
139
140	First argument is hash reference to name/value pairs
141	of options. This is optional.
142
143	Following is list of additional items. Each item
144	can be given as array reference. An array reference
145	is interpreted as [$item-body, $item-option-name =>
146	$item-option-value, $name => $value,...].
147	Available item-options are:
148
149	=over 2
150
151	=item C<group>
152
153	Group name which C<$item-body> belongs to. If there
154	is no such name of group, new group is created.
155
156	=item C<type> = 'mailbox' / 'group' (default 'group')
157
158	Format of C<$item-body>. If 'group' is specified,
159	<$item-body> is treated as RFC 2822 group. Otherwise,
160	it is added as a mailbox.
161
162	=back
163
164	=item $count = $addrs->count ([%options])
165
166	Returns the number of items. A 'type' option is available.
167	For example, C<$addrs-E<gt>count (-type =E<gt> 'group')>
168	returns the number of groups.
169
170	=item $addrs->delete ({%options}, $item-key, $key,...)
171
172	Deletes items that are matched with (one of) given key.
173	C<{%options}> is optional.
174
175	C<by> option is used to specify what sort of value given keys are.
176	C<display-name>, the default value, indicates
177	keys are display-name of items to be removed.
178
179	For C<by> option, value C<index> is also available.
180
181	C<type> option is also available. Its value is 'mailbox'
182	and 'group'. Default is both of them.
183
184	=cut
185
186	## add, count, delete: Inherited
187
188	sub _add_array_check ($$\%) {
189	my $self = shift;
190	my ($value, $option) = @_;
191	my $value_option = {};
192	if (ref $value eq 'ARRAY') {
193	($value, %$value_option) = @$value;
194	}
195	if (length $value_option->{group}) {
196	my $g = $self->item ($value_option->{group}, -type => 'group');
197	delete $value_option->{group};
198	$g->add (Message::Util::make_clone ($option), [$value, %$value_option]);
199	(0);
200	} else {
201	my $type = $value_option->{type} \|\| 'mailbox';
202	$value = $self->_parse_value ($type => $value) if $$option{parse};
203	$$option{parse} = 0;
204	(1, value => {type => $type, value => $value});
205	}
206	}
207
208	sub _delete_match ($$$\%\%) {
209	my $self = shift;
210	my ($by, $i, $list, $option) = @_;
211	return 0 unless ref $$i; ## Already removed
212	return 0 if $$option{type} && $$i->{type} ne $$option{type};
213	if ($by eq 'display-name') {
214	$$i->{value} = $self->_parse_value ($$i->{type}, $$i->{value});
215	return 1 if ref $$i->{value} && $$list{$$i->{value}->display_name};
216	} elsif ($by eq 'addr-spec') {
217	$$i->{value} = $self->_parse_value ($$i->{type}, $$i->{value});
218	return 1 if ref $$i->{value} && $$list{$$i->{value}->addr_spec};
219	}
220	0;
221	}
222	*_item_match = \&_delete_match;
223
224	## Returns returned item value \$item-value, \%option
225	sub _item_return_value ($\$\%) {
226	if (ref ${$_[1]}->{value}) {
227	${$_[1]}->{value};
228	} else {
229	${$_[1]}->{value} = $_[0]->_parse_value (${$_[1]}->{type}, ${$_[1]}->{value});
230	${$_[1]}->{value};
231	}
232	}
233	*_add_return_value = \&_item_return_value;
234
235	## Returns returned (new created) item value $name, \%option
236	sub _item_new_value ($$\%) {
237	my $type = $_[2]->{type} \|\| 'mailbox';
238	my $v = $_[0]->_parse_value ($type, '');
239	$v->display_name ($_[1]) if ref $v && length $_[1] && $_[2]->{by} eq 'display-name';
240	{type => $type, value => $v};
241	}
242
243	sub is_group ($;$) {
244	if (defined $_[1]) {
245	$_[0]->{option}->{is_group} = $_[1];
246	}
247	$_[0]->{option}->{is_group};
248	}
249
250	sub have_group ($) {
251	my $self = shift;
252	for (@{$self->{$self->{option}->{_ARRAY_NAME}}}) {
253	return 1 if $_->{type} eq 'group';
254	}
255	0;
256	}
257
258	sub display_name ($;$) {
259	if (defined $_[1]) {
260	$_[0]->{group_name} = $_[1];
261	}
262	$_[0]->{group_name};
263	}
264
265	sub addr_spec ($;%) {
266	my $self = shift;
267	my @a;
268	for (@{$self->{$self->{option}->{_ARRAY_NAME}}}) {
269	$_->{value} = $self->_parse_value
270	($_->{type} => $_->{value}) unless ref $_->{value};
271	if (ref $_->{value}) {
272	push @a, $_->{value}->addr_spec (@_);
273	} elsif (length $_->{value}) {
274	push @a, $_->{value};
275	}
276	}
277	wantarray? @a: $a[0];
278	}
279
280	## stringify: Inherited
281	#*as_string = \&stringify;
282
283	sub stringify ($;%) {
284	my $self = shift;
285	my %o = @_;
286	my %option = %{$self->{option}};
287	for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
288	my $m = $self->SUPER::stringify (@_);
289	my $g = '';
290	if ($option{is_group}) {
291	my %s = &{$option{hook_encode_string}} ($self,
292	$self->{group_name}, type => 'phrase');
293	$g .= Message::Util::quote_unsafe_string
294	($s{value}, unsafe => 'NON_atext_wsp');
295	}
296	if ($option{output_comment} && $option{output_group_name_comment}) {
297	if (!$option{is_group} && length $self->{group_name}) {
298	$g .= ' ('. $self->Message::Util::encode_ccontent ($self->{group_name}) .':)';
299	}
300	for (@{$self->{group_name_comment}}) {
301	$g .= ' ('. $self->Message::Util::encode_ccontent ($_) .')';
302	}
303	}
304	if ($option{is_group}) {
305	$m = $g . (length $m? ': ': ':') . $m . ';';
306	} else {
307	$m = $g . (length $g? ' ': '') . $m;
308	}
309	if ($option{output_comment} && !$option{output_group_name_comment}) {
310	for (@{$self->{group_name_comment}}) {
311	$m .= ' ('. $self->Message::Util::encode_ccontent ($_) .')';
312	}
313	}
314	if ($option{output_comment}) {
315	for (@{$self->{comment}}) {
316	$m .= ' ('. $self->Message::Util::encode_ccontent ($_) .')';
317	}
318	}
319	$m;
320	}
321	*as_string = \&stringify;
322	sub _stringify_item ($$\%) {
323	my $self = shift;
324	my $item = shift;
325	my $option = shift;
326	if (!$$option{can_have_group} && ref $item->{value}) {
327	$item->{value}->stringify (-is_group => 0);
328	} else {
329	$item->{value};
330	}
331	}
332
333	## option, value_type, clone, method_available: Inherited
334
335	=head1 LICENSE
336
337	Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
338
339	This program is free software; you can redistribute it and/or modify
340	it under the terms of the GNU General Public License as published by
341	the Free Software Foundation; either version 2 of the License, or
342	(at your option) any later version.
343
344	This program is distributed in the hope that it will be useful,
345	but WITHOUT ANY WARRANTY; without even the implied warranty of
346	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
347	GNU General Public License for more details.
348
349	You should have received a copy of the GNU General Public License
350	along with this program; see the file COPYING. If not, write to
351	the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
352	Boston, MA 02111-1307, USA.
353
354	=head1 CHANGE
355
356	See F<ChangeLog>.
357	$Date: 2002/06/09 11:08:27 $
358
359	=cut
360
361	1;