Message/Field/UA.pm


=head1 NAME

Message::Field::UA -- Perl module for Internet message
header field body consist of C<product> tokens

=cut

package Message::Field::UA;
use strict;
use vars qw(@ISA %REG $VERSION);
$VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require Message::Util;
require Message::Field::Structured;
push @ISA, qw(Message::Field::Structured);
use overload '""' => sub {shift->stringify},
             '@{}' => sub {shift->product};

*REG = \%Message::Util::REG;
$REG{product} = qr#(?:$REG{http_token}|$REG{quoted_string})(?:$REG{FWS}/$REG{FWS}(?:$REG{http_token}|$REG{quoted_string}))?#;
$REG{M_product} = qr#($REG{http_token}|$REG{quoted_string})(?:$REG{FWS}/$REG{FWS}($REG{http_token}|$REG{quoted_string}))?#;

=head1 CONSTRUCTORS

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

=over 4

=cut

## Initialize of this class -- called by constructors
sub _init ($;%) {
  my $self = shift;
  my %options = @_;
  my %DEFAULT = (
    #encoding_after_encode      ## Inherited
    #encoding_before_decode     ## Inherited
    -field_name => 'user-agent',
    #format     ## Inherited
    #hook_encode_string ## Inherited
    #hook_decode_string ## Inherited
    -prepend    => 1,
  );
  $self->SUPER::_init (%DEFAULT, %options);
}

=item Message::Field::UA->new ([%options])

Constructs a new C<Message::Field::UA> object.  You might pass some 
options as parameters to the constructor.

=cut

## Inherited

=item Message::Field::UA->parse ($field-body, [%options])

Constructs a new C<Message::Field::UA> 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 $field_body = shift;  my @ua = ();
  $self->_init (@_);
  $field_body =~ s{^((?:$REG{FWS}$REG{comment})+)}{
    my $comments = $1;
    $comments =~ s{$REG{M_comment}}{
      my $comment = $self->Message::Util::decode_ccontent ($1);
      push @ua, {comment => [$comment]} if $comment;
    }goex;
    '';
  }goex;
  $field_body =~ s{$REG{M_product}((?:$REG{FWS}$REG{comment})*)}{
    my ($product, $product_version, $comments) = ($1, $2, $3);
    for ($product, $product_version) {
      my ($s,$q) = (Message::Util::unquote_if_quoted_string ($_), 0);
      my %s = &{$self->{option}->{hook_decode_string}} ($self, $s,
                type => ($q?'token/quoted':'token'));   ## What token/quoted is? :-)
      $_ = $s{value};
    }
    my @comment = ();
    $comments =~ s{$REG{M_comment}}{
      my $comment = $self->Message::Util::decode_ccontent ($1);
      push @comment, $comment if $comment;
    }goex;
    push @ua, {name => $product, version => $product_version, 
               comment => \@comment};
  }goex;
  $self->{product} = \@ua;
  $self;
}

=back

=head1 METHODS

=over 4

=item $self->stringify ()

Returns C<field-body> as a string.

=cut

sub stringify ($;%) {
  my $self = shift;
  my %option = @_;
  $option{format} ||= $self->{option}->{format};
  my @r = ();
  for my $p (@{$self->{product}}) {
    if ($p->{name}) {
      if ($option{format} eq 'http'
        && (  $p->{name} =~ /$REG{NON_http_token}/
           || $p->{version} =~ /$REG{NON_http_token}/)) {
        my $f = $p->{name};
        $f .= '/'.$p->{version} if $p->{version};
        push @r, '('. $self->encode_ccontent ($f) .')';
      } else {
        my %e = &{$self->{option}->{hook_encode_string}} ($self, 
           $p->{name}, type => 'token');
        my %f = &{$self->{option}->{hook_encode_string}} ($self, 
           $p->{version}, type => 'token');
        push @r, 
          Message::Util::quote_unsafe_string ($e{value}, unsafe => 'NON_http_token')
          .($f{value} ? '/'
          .Message::Util::quote_unsafe_string ($f{value}, unsafe => 'NON_http_token')
          :'');
      }
    } elsif ($p->{version}) {   ## Error!
      push @r, '('. $self->Message::Util::encode_ccontent ($p->{version}) .')';
    }
    for (@{$p->{comment}}) {
      push @r, '('. $self->Message::Util::encode_ccontent ($_) .')' if $_;
    }
  }
  join ' ', @r;
}
*as_string = \&stringify;

=item $array = $self->product

Returns array reference of C<product>s.  Each of array elements
are hash reference, and it has three key: C<name>, C<version>,
and C<comment>.  C<comment> is array reference.

Example:

  my $p = $ua->product->[0];
  printf "%s\t%s\t%s\n", $p->{name}, $p->{version}, join ('; ', @{$p->{comment}});

=cut

sub product ($;%) {
  my $self = shift;
  $self->_delete_empty;
  $self->{product};
}

=item $name = $ua->product_name ($index)

=item $version = $ua->product_version ($index)

Returns product-name/-version of C<$index>'th C<product>.

=cut

sub product_name ($;$%) {
  my $self = shift;
  my $index = shift;
  $self->{product}->[$index]->{product} if ref $self->{product}->[$index];
}

sub product_version ($;$%) {
  my $self = shift;
  my $index = shift;
  $self->{product}->[$index]->{product_version} if ref $self->{product}->[$index];
}

=item $comment_ref = $ua->product_comment ($index)

Returns array reference of C<comment> of C<$index>'th C<product>.
(You can edit this array.)

=cut

sub product_comment ($;$%) {
  my $self = shift;
  my $index = shift;
  $self->{product}->[$index]->{comment} if ref $self->{product}->[$index];
}

=item $hdr->add ($name, $version, [$name, $version, ...])

Adds some field name/version pairs.  Even if there are
one or more C<product>s whose name is same as C<$name>
(case sensible), given name/body pairs are ADDed.  Use C<replace>
to remove C<old> one.

Instead of C<$version>, you can pass array reference.
[0] is used for C<version>, the others are saved as elements
of C<comment>.

C<-prepend> options is available.  C<1> is default.

Example:

  $ua->add (Perl => [$^V, $^O], 'foo.pl' => $VERSION, -prepend => 0);
  print $ua;    # foo.pl/1.00 Perl/5.6.1 (MSWin32)

=cut

sub add ($%) {
  my $self = shift;
  my %products = @_;
  my %option = %{$self->{option}};
  for (grep {/^-/} keys %products) {$option{substr ($_, 1)} = $products{$_}}
  for (grep {/^[^-]/} keys %products) {
    my $name = $_;
    my ($ver, $comment);
    if (ref $products{$_} eq 'ARRAY') {
      $ver = shift @{$products{$_}};
      $comment = $products{$_};
    } else {
      $ver = $products{$_};
      $comment = [];
    }
    ## BUG: binary unsafe:-) (ISO-2022-KR, UCS-2,... also can't treat)
    if ($ver =~ /[\x00-\x08\x0B\x0E-\x1A\x1C-\x1F\x7F]/) {
      $ver = sprintf '%vd', $ver;
    }
    if ($option{prepend}) {
      unshift @{$self->{product}}, {name => $name, version => $ver,
                                    comment => $comment};
    } else {
      push @{$self->{product}}, {name => $name, version => $ver,
                                 comment => $comment};
    }
  }
}

=item $hdr->replace ($field-name, $field-body, [$name, $body, ...])

Adds some field name/body pairs.  If there are already
one or more field with name of C<$field-name>, it is replaced 
by new one.

Instead of C<$version>, you can pass array reference.
[0] is used for C<version>, the others are saved as elements
of C<comment>.

C<-prepend> options is available.  C<1> is default.

=cut

sub replace ($%) {
  my $self = shift;
  my %params = @_;
  my %option = %{$self->{option}};
  for (grep {/^-/} keys %params) {$option{substr ($_, 1)} = $params{$_}}
  my (%new_product);
  for (grep {/^[^-]/} keys %params) {
    my $name = $_;
    my ($ver, $comment);
    if (ref $params{$_} eq 'ARRAY') {
      $ver = shift @{$params{$_}};
      $comment = $params{$_};
    } else {
      $ver = $params{$_};
      $comment = [];
    }
    ## BUG: binary unsafe:-) (ISO-2022-KR, UCS-2,... also can't treat)
    if ($ver =~ /[\x00-\x08\x0B\x0E-\x1A\x1C-\x1F\x7F]/) {
      $ver = sprintf '%vd', $ver;
    }
    $new_product{$name} = {name => $name, version => $ver, comment => $comment};
  }
  for my $product (@{$self->{product}}) {
    if (defined $new_product{$product->{name}}) {
      $product = $new_product {$product->{name}};
      $new_product{$product->{name}} = undef;
    }
  }
  for (keys %new_product) {
    push @{$self->{product}}, $new_product{$_};
  }
}

=item $ua->delete ($name, [$name, $name,...]);

Deletes C<product>s whose name is C<$name>.

=cut

sub delete ($@) {
  my $self = shift;
  my %delete;  for (@_) {$delete{$_} = 1}
  for my $product (@{$self->{product}}) {
    undef $product if $delete{$product->{name}};
  }
}

sub _delete_empty ($) {
  my $self = shift;
  my @nid;
  for my $id (@{$self->{product}}) {push @nid, $id if ref $id}
  $self->{product} = \@nid;
}

=item $option-value = $ua->option ($option-name)

Gets option value.

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

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

=cut

## Inherited

=item $clone = $ua->clone ()

Returns a copy of the object.

=cut

sub clone ($) {
  my $self = shift;
  $self->_delete_empty;
  my $clone = $self->SUPER::clone;
  my @p;
  for (@{$self->{product}}) {
    my $name = ref $_->{name}? $_->{name}->clone: $_->{name};
    my $ver = ref $_->{version}? $_->{version}->clone: $_->{version};
    my @comment;
    for (@{$_->{comment}}) {
      push @comment, ref $_? $_->clone: $_;
    }
    push @p, {name => $name, version => $ver, comment => \@comment};
  }
  $clone->{product} = \@p;
  $clone;
}

=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: $

=cut

1;
1	wakaba	1.1
2			=head1 NAME
3
4	wakaba	1.4	Message::Field::UA -- Perl module for Internet message
5			header field body consist of C<product> tokens
6	wakaba	1.1
7			=cut
8
9			package Message::Field::UA;
10			use strict;
11	wakaba	1.4	use vars qw(@ISA %REG $VERSION);
12			$VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
13	wakaba	1.1	require Message::Util;
14	wakaba	1.4	require Message::Field::Structured;
15			push @ISA, qw(Message::Field::Structured);
16	wakaba	1.1	use overload '""' => sub {shift->stringify},
17			'@{}' => sub {shift->product};
18
19	wakaba	1.4	*REG = \%Message::Util::REG;
20	wakaba	1.1	$REG{product} = qr#(?:$REG{http_token}\|$REG{quoted_string})(?:$REG{FWS}/$REG{FWS}(?:$REG{http_token}\|$REG{quoted_string}))?#;
21	wakaba	1.4	$REG{M_product} = qr#($REG{http_token}\|$REG{quoted_string})(?:$REG{FWS}/$REG{FWS}($REG{http_token}\|$REG{quoted_string}))?#;
22
23			=head1 CONSTRUCTORS
24
25			The following methods construct new C<Message::Field::Numval> objects:
26	wakaba	1.1
27	wakaba	1.4	=over 4
28	wakaba	1.1
29	wakaba	1.4	=cut
30	wakaba	1.1
31	wakaba	1.4	## Initialize of this class -- called by constructors
32			sub _init ($;%) {
33			my $self = shift;
34			my %options = @_;
35			my %DEFAULT = (
36			#encoding_after_encode ## Inherited
37			#encoding_before_decode ## Inherited
38			-field_name => 'user-agent',
39			#format ## Inherited
40			#hook_encode_string ## Inherited
41			#hook_decode_string ## Inherited
42			-prepend => 1,
43			);
44			$self->SUPER::_init (%DEFAULT, %options);
45			}
46	wakaba	1.1
47	wakaba	1.4	=item Message::Field::UA->new ([%options])
48	wakaba	1.1
49	wakaba	1.4	Constructs a new C<Message::Field::UA> object. You might pass some
50			options as parameters to the constructor.
51	wakaba	1.1
52			=cut
53
54	wakaba	1.4	## Inherited
55	wakaba	1.1
56	wakaba	1.4	=item Message::Field::UA->parse ($field-body, [%options])
57	wakaba	1.1
58	wakaba	1.4	Constructs a new C<Message::Field::UA> object with
59			given field body. You might pass some options as parameters to the constructor.
60	wakaba	1.1
61			=cut
62
63			sub parse ($$;%) {
64			my $class = shift;
65	wakaba	1.4	my $self = bless {}, $class;
66	wakaba	1.1	my $field_body = shift; my @ua = ();
67	wakaba	1.4	$self->_init (@_);
68	wakaba	1.1	$field_body =~ s{^((?:$REG{FWS}$REG{comment})+)}{
69			my $comments = $1;
70			$comments =~ s{$REG{M_comment}}{
71	wakaba	1.4	my $comment = $self->Message::Util::decode_ccontent ($1);
72	wakaba	1.1	push @ua, {comment => [$comment]} if $comment;
73			}goex;
74	wakaba	1.2	'';
75	wakaba	1.1	}goex;
76			$field_body =~ s{$REG{M_product}((?:$REG{FWS}$REG{comment})*)}{
77			my ($product, $product_version, $comments) = ($1, $2, $3);
78			for ($product, $product_version) {
79	wakaba	1.4	my ($s,$q) = (Message::Util::unquote_if_quoted_string ($_), 0);
80	wakaba	1.1	my %s = &{$self->{option}->{hook_decode_string}} ($self, $s,
81			type => ($q?'token/quoted':'token')); ## What token/quoted is? :-)
82			$_ = $s{value};
83			}
84			my @comment = ();
85			$comments =~ s{$REG{M_comment}}{
86	wakaba	1.4	my $comment = $self->Message::Util::decode_ccontent ($1);
87	wakaba	1.1	push @comment, $comment if $comment;
88			}goex;
89	wakaba	1.4	push @ua, {name => $product, version => $product_version,
90	wakaba	1.1	comment => \@comment};
91			}goex;
92			$self->{product} = \@ua;
93			$self;
94			}
95
96	wakaba	1.4	=back
97
98			=head1 METHODS
99
100			=over 4
101
102			=item $self->stringify ()
103	wakaba	1.1
104			Returns C<field-body> as a string.
105
106			=cut
107
108	wakaba	1.2	sub stringify ($;%) {
109	wakaba	1.1	my $self = shift;
110	wakaba	1.2	my %option = @_;
111			$option{format} \|\|= $self->{option}->{format};
112	wakaba	1.1	my @r = ();
113			for my $p (@{$self->{product}}) {
114	wakaba	1.4	if ($p->{name}) {
115	wakaba	1.2	if ($option{format} eq 'http'
116	wakaba	1.4	&& ( $p->{name} =~ /$REG{NON_http_token}/
117			\|\| $p->{version} =~ /$REG{NON_http_token}/)) {
118			my $f = $p->{name};
119			$f .= '/'.$p->{version} if $p->{version};
120			push @r, '('. $self->encode_ccontent ($f) .')';
121	wakaba	1.2	} else {
122			my %e = &{$self->{option}->{hook_encode_string}} ($self,
123	wakaba	1.4	$p->{name}, type => 'token');
124	wakaba	1.2	my %f = &{$self->{option}->{hook_encode_string}} ($self,
125	wakaba	1.4	$p->{version}, type => 'token');
126			push @r,
127			Message::Util::quote_unsafe_string ($e{value}, unsafe => 'NON_http_token')
128			.($f{value} ? '/'
129			.Message::Util::quote_unsafe_string ($f{value}, unsafe => 'NON_http_token')
130			:'');
131	wakaba	1.2	}
132	wakaba	1.4	} elsif ($p->{version}) { ## Error!
133			push @r, '('. $self->Message::Util::encode_ccontent ($p->{version}) .')';
134	wakaba	1.1	}
135			for (@{$p->{comment}}) {
136	wakaba	1.4	push @r, '('. $self->Message::Util::encode_ccontent ($_) .')' if $_;
137	wakaba	1.1	}
138			}
139			join ' ', @r;
140			}
141	wakaba	1.4	*as_string = \&stringify;
142
143			=item $array = $self->product
144
145			Returns array reference of C<product>s. Each of array elements
146			are hash reference, and it has three key: C<name>, C<version>,
147			and C<comment>. C<comment> is array reference.
148
149			Example:
150
151			my $p = $ua->product->[0];
152			printf "%s\t%s\t%s\n", $p->{name}, $p->{version}, join ('; ', @{$p->{comment}});
153
154			=cut
155	wakaba	1.1
156			sub product ($;%) {
157			my $self = shift;
158			$self->_delete_empty;
159	wakaba	1.3	$self->{product};
160	wakaba	1.1	}
161
162	wakaba	1.4	=item $name = $ua->product_name ($index)
163
164			=item $version = $ua->product_version ($index)
165
166			Returns product-name/-version of C<$index>'th C<product>.
167
168			=cut
169
170	wakaba	1.1	sub product_name ($;$%) {
171			my $self = shift;
172			my $index = shift;
173			$self->{product}->[$index]->{product} if ref $self->{product}->[$index];
174			}
175
176			sub product_version ($;$%) {
177			my $self = shift;
178			my $index = shift;
179			$self->{product}->[$index]->{product_version} if ref $self->{product}->[$index];
180			}
181
182	wakaba	1.4	=item $comment_ref = $ua->product_comment ($index)
183
184			Returns array reference of C<comment> of C<$index>'th C<product>.
185			(You can edit this array.)
186
187			=cut
188
189	wakaba	1.1	sub product_comment ($;$%) {
190			my $self = shift;
191			my $index = shift;
192	wakaba	1.4	$self->{product}->[$index]->{comment} if ref $self->{product}->[$index];
193	wakaba	1.1	}
194
195	wakaba	1.4	=item $hdr->add ($name, $version, [$name, $version, ...])
196
197			Adds some field name/version pairs. Even if there are
198			one or more C<product>s whose name is same as C<$name>
199			(case sensible), given name/body pairs are ADDed. Use C<replace>
200			to remove C<old> one.
201
202			Instead of C<$version>, you can pass array reference.
203			[0] is used for C<version>, the others are saved as elements
204			of C<comment>.
205
206			C<-prepend> options is available. C<1> is default.
207
208			Example:
209
210			$ua->add (Perl => [$^V, $^O], 'foo.pl' => $VERSION, -prepend => 0);
211			print $ua; # foo.pl/1.00 Perl/5.6.1 (MSWin32)
212
213			=cut
214
215			sub add ($%) {
216	wakaba	1.1	my $self = shift;
217	wakaba	1.4	my %products = @_;
218			my %option = %{$self->{option}};
219			for (grep {/^-/} keys %products) {$option{substr ($_, 1)} = $products{$_}}
220			for (grep {/^[^-]/} keys %products) {
221			my $name = $_;
222			my ($ver, $comment);
223			if (ref $products{$_} eq 'ARRAY') {
224			$ver = shift @{$products{$_}};
225			$comment = $products{$_};
226			} else {
227			$ver = $products{$_};
228			$comment = [];
229			}
230			## BUG: binary unsafe:-) (ISO-2022-KR, UCS-2,... also can't treat)
231			if ($ver =~ /[\x00-\x08\x0B\x0E-\x1A\x1C-\x1F\x7F]/) {
232			$ver = sprintf '%vd', $ver;
233			}
234			if ($option{prepend}) {
235			unshift @{$self->{product}}, {name => $name, version => $ver,
236			comment => $comment};
237			} else {
238			push @{$self->{product}}, {name => $name, version => $ver,
239			comment => $comment};
240			}
241	wakaba	1.1	}
242			}
243
244	wakaba	1.4	=item $hdr->replace ($field-name, $field-body, [$name, $body, ...])
245
246			Adds some field name/body pairs. If there are already
247			one or more field with name of C<$field-name>, it is replaced
248			by new one.
249
250			Instead of C<$version>, you can pass array reference.
251			[0] is used for C<version>, the others are saved as elements
252			of C<comment>.
253
254			C<-prepend> options is available. C<1> is default.
255
256			=cut
257
258			sub replace ($%) {
259	wakaba	1.1	my $self = shift;
260	wakaba	1.4	my %params = @_;
261			my %option = %{$self->{option}};
262			for (grep {/^-/} keys %params) {$option{substr ($_, 1)} = $params{$_}}
263			my (%new_product);
264			for (grep {/^[^-]/} keys %params) {
265			my $name = $_;
266			my ($ver, $comment);
267			if (ref $params{$_} eq 'ARRAY') {
268			$ver = shift @{$params{$_}};
269			$comment = $params{$_};
270			} else {
271			$ver = $params{$_};
272			$comment = [];
273			}
274			## BUG: binary unsafe:-) (ISO-2022-KR, UCS-2,... also can't treat)
275			if ($ver =~ /[\x00-\x08\x0B\x0E-\x1A\x1C-\x1F\x7F]/) {
276			$ver = sprintf '%vd', $ver;
277			}
278			$new_product{$name} = {name => $name, version => $ver, comment => $comment};
279			}
280			for my $product (@{$self->{product}}) {
281			if (defined $new_product{$product->{name}}) {
282			$product = $new_product {$product->{name}};
283			$new_product{$product->{name}} = undef;
284	wakaba	1.1	}
285			}
286	wakaba	1.4	for (keys %new_product) {
287			push @{$self->{product}}, $new_product{$_};
288			}
289			}
290
291			=item $ua->delete ($name, [$name, $name,...]);
292
293			Deletes C<product>s whose name is C<$name>.
294
295			=cut
296
297			sub delete ($@) {
298			my $self = shift;
299			my %delete; for (@_) {$delete{$_} = 1}
300			for my $product (@{$self->{product}}) {
301			undef $product if $delete{$product->{name}};
302	wakaba	1.1	}
303			}
304
305			sub _delete_empty ($) {
306			my $self = shift;
307			my @nid;
308			for my $id (@{$self->{product}}) {push @nid, $id if ref $id}
309			$self->{product} = \@nid;
310			}
311
312	wakaba	1.4	=item $option-value = $ua->option ($option-name)
313
314			Gets option value.
315
316			=item $ua->option ($option-name, $option-value, ...)
317
318			Set option value(s). You can pass multiple option name-value pair
319			as parameter when setting.
320
321			=cut
322
323			## Inherited
324
325			=item $clone = $ua->clone ()
326
327			Returns a copy of the object.
328
329			=cut
330
331			sub clone ($) {
332	wakaba	1.1	my $self = shift;
333	wakaba	1.4	$self->_delete_empty;
334			my $clone = $self->SUPER::clone;
335			my @p;
336			for (@{$self->{product}}) {
337			my $name = ref $_->{name}? $_->{name}->clone: $_->{name};
338			my $ver = ref $_->{version}? $_->{version}->clone: $_->{version};
339			my @comment;
340			for (@{$_->{comment}}) {
341			push @comment, ref $_? $_->clone: $_;
342			}
343			push @p, {name => $name, version => $ver, comment => \@comment};
344	wakaba	1.1	}
345	wakaba	1.4	$clone->{product} = \@p;
346			$clone;
347	wakaba	1.1	}
348
349	wakaba	1.4	=back
350	wakaba	1.1
351			=head1 LICENSE
352
353			Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
354
355			This program is free software; you can redistribute it and/or modify
356			it under the terms of the GNU General Public License as published by
357			the Free Software Foundation; either version 2 of the License, or
358			(at your option) any later version.
359
360			This program is distributed in the hope that it will be useful,
361			but WITHOUT ANY WARRANTY; without even the implied warranty of
362			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
363			GNU General Public License for more details.
364
365			You should have received a copy of the GNU General Public License
366			along with this program; see the file COPYING. If not, write to
367			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
368			Boston, MA 02111-1307, USA.
369
370			=head1 CHANGE
371
372			See F<ChangeLog>.
373	wakaba	1.4	$Date: $
374	wakaba	1.1
375			=cut
376
377			1;