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.4 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
require Message::Util;
require Message::Field::Structured;
push @ISA, qw(Message::Field::Structured);
use overload '""'       => sub { $_[0]->stringify },
             '@{}'      => sub { $_[0]->product },
             '.='       => sub { 
                if (ref $_[1] eq 'HASH') {
                  $_[0]->add (%{$_[1]});
                } elsif (ref $_[1] eq 'ARRAY') {
                  $_[0]->add (@{$_[1]});
                } else {
                  $_[0]->add ($_[1] => '', -prepend => 0);
                }
                $_[0];
             },
             fallback   => 1;

*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 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);
  my @a = ();
  for (grep {/^[^-]/} keys %options) {
    push @a, $_ => $options{$_};
  }
  $self->add (@a) if $#a > -1;
}

=item $ua = 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 $ua = 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;
  push @{$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: 2002/04/06 06:01:04 $

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