Message/Field/Address.pm


=head1 NAME

Message::Field::Address Perl module

=head1 DESCRIPTION

Perl module for RFC 822/2822 address related C<field>s.

=cut

package Message::Field::Address;
require 5.6.0;
use strict;
use re 'eval';
use vars qw(%REG $VERSION);
$VERSION = '1.00';

use overload '@{}' => sub {shift->{address}},
             '""' => sub {shift->stringify};

$REG{comment} = qr/\x28(?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x27\x2A-\x5B\x5D-\xFF]+|(??{$REG{comment}}))*\x29/;
$REG{quoted_string} = qr/\x22(?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\xFF])*\x22/;
$REG{domain_literal} = qr/\x5B(?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x5A\x5E-\xFF])*\x5D/;

$REG{WSP} = qr/[\x20\x09]+/;
$REG{FWS} = qr/[\x20\x09]*/;
$REG{atext} = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2F\x30-\x39\x3D\x3F\x41-\x5A\x5E-\x7E]+/;
$REG{dot_atom} = qr/$REG{atext}(?:$REG{FWS}\x2E$REG{FWS}$REG{atext})*/;
$REG{dot_word} = qr/(?:$REG{atext}|$REG{quoted_string})(?:$REG{FWS}\x2E$REG{FWS}(?:$REG{atext}|$REG{quoted_string}))*/;
$REG{phrase} = qr/(?:$REG{atext}|$REG{quoted_string})(?:$REG{atext}|$REG{quoted_string}|\.|$REG{FWS})*/;
$REG{obs_route} = qr/(?:\x40$REG{FWS}(?:$REG{dot_word}|$REG{domain_literal})(?:$REG{FWS},?$REG{FWS}\x40$REG{FWS}(?:$REG{dot_word}|$REG{domain_literal}))*):/;
$REG{addr_spec} = qr/$REG{dot_word}$REG{FWS}\x40$REG{FWS}(?:$REG{dot_atom}|$REG{domain_literal})/;
$REG{mailbox} = qr/(?:(?:$REG{phrase})?<$REG{FWS}(?:$REG{obs_route})?$REG{FWS}$REG{addr_spec}$REG{FWS}>|$REG{addr_spec})/;
$REG{mailbox_list} = qr/$REG{mailbox}(?:$REG{FWS},(?:$REG{FWS}$REG{mailbox})?)*/;
$REG{address} = qr/(?:(?:$REG{phrase})?(?:<$REG{FWS}(?:$REG{obs_route})?$REG{FWS}$REG{addr_spec}$REG{FWS}>|:$REG{FWS}(?:$REG{mailbox_list}$REG{FWS})?;)|$REG{addr_spec})/;
$REG{address_list} = qr/$REG{address}(?:$REG{FWS},(?:$REG{FWS}$REG{address})?)*/;
$REG{M_group} = qr/($REG{phrase}):/;
$REG{M_mailbox} = qr/(?:($REG{phrase})?<$REG{FWS}($REG{obs_route})?$REG{FWS}($REG{addr_spec})$REG{FWS}>|($REG{addr_spec}))/;
$REG{M_quoted_string} = qr/\x22((?:\x5C[\x00-\xFF]|[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\xFF])*)\x22/;

$REG{NON_atom} = qr/[^\x09\x20\x21\x23-\x27\x2A\x2B\x2D\x2F\x30-\x39\x3D\x3F\x41-\x5A\x5E-\x7E]/;

=head2 Message::Field::Address->new ()

Return empty address object.

=cut

sub new ($) {
  bless {type => '_ROOT'}, shift;
}

=head2 Message::Field::Address->parse ($unfolded_field_body)

Parse structured C<field-body> contain of C<address-list>.

=cut

sub parse ($$) {
  my $self = bless {}, shift;
  my $field_body = shift;
  $field_body = $self->delete_comment ($field_body);
  my %addr = $self->parse_address_list ($field_body);
  $self->{address} = $addr{address};
  $self->{type}    = $addr{type};
  $self;
}

=head2 $self->address ()

Return address list in the format described in
L<$self-E<gt>parse_address_list ()>.

=cut

sub address ($) {@{shift->{address}}}

=head2 $self->add ($addr_spec, [%option])

Add an mail address to C<$self> (address object).
%option = (name => C<display-name>, route => C<route>, 
           group => C<display-name> of C<group>)

Note that this method (and other methods) does not check
$addr_spec and $option{route} is valid or not.

=cut

sub add ($$;%) {
  my $self = shift;
  my ($addr, %option) = @_;
  my $name = $option{name} || $option{display_name};
  unless ($option{group}) {
    push @{$self->{address}}, {type => 'mailbox',
         addr_spec => $addr, display_name => $name, route => $option{route}};
  } else {
    for my $i (@{$self->{address}}) {
      if ($i->{type} eq 'group' && $i->{display_name} eq $option{group}) {
        push @{$i->{address}}, {type => 'mailbox',
             addr_spec => $addr, display_name => $name, route => $option{route}};
        return $self;
      }
    }
    push @{$self->{address}}, {type => 'group', display_name => $option{group},
         address => [
           {type => 'mailbox',
            addr_spec => $addr, display_name => $name, route => $option{route}}
         ]};
  }
  $self;
}

sub stringify ($) {
  my $self = shift;
  my @return;
  for my $address (@{$self->{address}}) {
    my $return = '';
    next if !$address->{addr_spec} && $address->{type} ne 'group';
    if ($address->{display_name}) {
      $return = $self->quote_unsafe_string ($address->{display_name})
        .($address->{type} eq 'group'? ': ': ' ');
    }
    if ($address->{type} ne 'group') {
      $return .= '<'.$address->{route}.$address->{addr_spec}.'>';
    } else {
      my (@g_return);
      for my $mailbox (@{$address->{address}}) {
        next unless $mailbox->{addr_spec};
        my $g_return = '';
        $g_return = $self->quote_unsafe_string ($mailbox->{display_name}) .' '
          if $mailbox->{display_name};
        $g_return .= '<'.$mailbox->{route}.$mailbox->{addr_spec}.'>';
        push @g_return, $g_return;
      }
      $return .= join ', ', @g_return;
      $return .= ';' if $address->{type} eq 'group';
    }
    push @return, $return;
  }
  join ', ', @return;
}

sub quote_unsafe_string ($$) {
  my $self = shift;
  my $string = shift;
  if ($string =~ /$REG{NON_atom}/ || $string =~ /$REG{WSP}$REG{WSP}+/) {
    $string =~ s/([\x22\x5C])/\x5C$1/g;
    $string = '"'.$string.'"';
  }
  $string;
}

=head2 $self->unquote_quoted_string ($string)

Unquote C<quoted-string>.  Get rid of C<DQUOTE>s and
C<REVERSED SOLIDUS> included in C<quoted-pair>.
This method is intended for internal use.

=cut

sub unquote_quoted_string ($$) {
  my $self = shift;
  my $quoted_string = shift;
  $quoted_string =~ s{$REG{M_quoted_string}}{
    my $qtext = $1;
    $qtext =~ s/\x5C([\x00-\xFF])/$1/g;
    $qtext;
  }goex;
  $quoted_string;
}

=head2 $self->parse_mailbox ($mailbox)

Parse C<mailbox> and return array of C<addr-spec>,
C<display-name> and C<route> (aka C<obs-route> of RFC 2822).
This method is intended for internal use.

=cut

sub parse_mailbox ($$) {
  my $self = shift;
  my $mailbox = shift;
  if ($mailbox =~ /$REG{M_mailbox}/) {
    my ($display_name, $route, $addr_spec) = ($1, $2, $3 || $4);
    $display_name =~ s/$REG{WSP}+$//;
    $display_name = $self->unquote_quoted_string ($display_name);
    $addr_spec =~ s{($REG{quoted_string}|$REG{domain_literal})|$REG{WSP}}{$1}go;
    $route =~ s{($REG{quoted_string}|$REG{domain_literal})|$REG{WSP}}{$1}go;
    return ($addr_spec, $display_name, $route);
  }
}

=head2 $self->parse_address_list ($address_list)

Parse C<address-list> and return hash.
This method is intended for internal use.

=head3 Structure of hash returned by parse_address_list

%address = (

  type  => '_ROOT',
  address       => [
  
    ## mailbox
    {
      type      => 'mailbox',
      display_name      => 'Foo H. Bar',
      addr_spec => '[email protected]',
      route     => '@hoge.example:',
    },
    
    ## group
    {
      type      => 'group',
      display_name      => 'The committee',
      address   => [
        
        ## mailbox
        {
          type  => 'mailbox',
          display_name  => 'Tom (Director)',
          addr_spec     => '[email protected]',
          route => '',
        }
        
      ],
    },
  
  ],

);

=cut

sub parse_address_list ($$) {
  my $self = shift;
  my $address_list = shift;
  my %r_addr = (type => '_ROOT');
  $address_list =~ s{($REG{address})}{
    my $address = $1;
    if ($address =~ /^$REG{M_group}/) {
      my %r_group = (type => 'group', display_name => $1);
      $r_group{display_name} =~ s/$REG{WSP}+$//;
      $r_group{display_name} = $self->unquote_quoted_string ($r_group{display_name});
      $address =~ s{($REG{mailbox})}{
        my ($addr, $name, $route) = $self->parse_mailbox ($1);
        push @{$r_group{address}}, {type => 'mailbox',
           display_name => $name, route => $route, addr_spec => $addr};
      }goex;
      push @{$r_addr{address}}, \%r_group;
    } else {
      my ($addr, $name, $route) = $self->parse_mailbox ($address);
      push @{$r_addr{address}}, {type => 'mailbox',
           display_name => $name, route => $route, addr_spec => $addr};
    }
  }goex;
  %r_addr;
}

=head2 $self->delete_comment ($field_body)

Remove all C<comment> in given strictured C<field-body>.
This method is intended for internal use.

=cut

sub delete_comment ($$) {
  my $self = shift;
  my $body = shift;
  $body =~ s{($REG{quoted_string}|$REG{domain_literal})|$REG{comment}}{
    my $o = $1;  $o? $o : ' ';
  }gex;
  $body;
}

=head1 EXAMPLE

  ## Compose field-body for To: field.
  
  use Message::Field::Address;
  my $addr = new Message::Field::Address;
  $addr->add ('[email protected]', name => 'Mr. foo bar');
  $addr->add ('[email protected]', group => 'administrators');
  $addr->add ('[email protected]', group => 'administrators');
  
  my $field_body = $addr->stringify ();


  ## Output parsed address-list tree.
  
  use Message::Field::Address;
  my $addr = Message::Field::Address->parse ($field_body);
  
  for my $i (@$addr) {
    if ($i->{type} eq 'group') {
      print "\x40 $i->{display_name}: \n";
      for my $j (@{$i->{address}}) {
        print "\t- $j->{display_name} <$j->{route}$j->{addr_spec}>\n";
      }
    } else {
      print "- $i->{display_name} <$i->{route}$i->{addr_spec}>\n";
    }
  }

=head1 LICENSE

Copyright 2002 wakaba E<lt>[email protected]<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
2	=head1 NAME
3
4	Message::Field::Address Perl module
5
6	=head1 DESCRIPTION
7
8	Perl module for RFC 822/2822 address related C<field>s.
9
10	=cut
11
12	package Message::Field::Address;
13	require 5.6.0;
14	use strict;
15	use re 'eval';
16	use vars qw(%REG $VERSION);
17	$VERSION = '1.00';
18
19	use overload '@{}' => sub {shift->{address}},
20	'""' => sub {shift->stringify};
21
22	$REG{comment} = qr/\x28(?:\x5C[\x00-\xFF]\|[\x00-\x0C\x0E-\x27\x2A-\x5B\x5D-\xFF]+\|(??{$REG{comment}}))*\x29/;
23	$REG{quoted_string} = qr/\x22(?:\x5C[\x00-\xFF]\|[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\xFF])*\x22/;
24	$REG{domain_literal} = qr/\x5B(?:\x5C[\x00-\xFF]\|[\x00-\x0C\x0E-\x5A\x5E-\xFF])*\x5D/;
25
26	$REG{WSP} = qr/[\x20\x09]+/;
27	$REG{FWS} = qr/[\x20\x09]*/;
28	$REG{atext} = qr/[\x21\x23-\x27\x2A\x2B\x2D\x2F\x30-\x39\x3D\x3F\x41-\x5A\x5E-\x7E]+/;
29	$REG{dot_atom} = qr/$REG{atext}(?:$REG{FWS}\x2E$REG{FWS}$REG{atext})*/;
30	$REG{dot_word} = qr/(?:$REG{atext}\|$REG{quoted_string})(?:$REG{FWS}\x2E$REG{FWS}(?:$REG{atext}\|$REG{quoted_string}))*/;
31	$REG{phrase} = qr/(?:$REG{atext}\|$REG{quoted_string})(?:$REG{atext}\|$REG{quoted_string}\|\.\|$REG{FWS})*/;
32	$REG{obs_route} = qr/(?:\x40$REG{FWS}(?:$REG{dot_word}\|$REG{domain_literal})(?:$REG{FWS},?$REG{FWS}\x40$REG{FWS}(?:$REG{dot_word}\|$REG{domain_literal}))*):/;
33	$REG{addr_spec} = qr/$REG{dot_word}$REG{FWS}\x40$REG{FWS}(?:$REG{dot_atom}\|$REG{domain_literal})/;
34	$REG{mailbox} = qr/(?:(?:$REG{phrase})?<$REG{FWS}(?:$REG{obs_route})?$REG{FWS}$REG{addr_spec}$REG{FWS}>\|$REG{addr_spec})/;
35	$REG{mailbox_list} = qr/$REG{mailbox}(?:$REG{FWS},(?:$REG{FWS}$REG{mailbox})?)*/;
36	$REG{address} = qr/(?:(?:$REG{phrase})?(?:<$REG{FWS}(?:$REG{obs_route})?$REG{FWS}$REG{addr_spec}$REG{FWS}>\|:$REG{FWS}(?:$REG{mailbox_list}$REG{FWS})?;)\|$REG{addr_spec})/;
37	$REG{address_list} = qr/$REG{address}(?:$REG{FWS},(?:$REG{FWS}$REG{address})?)*/;
38	$REG{M_group} = qr/($REG{phrase}):/;
39	$REG{M_mailbox} = qr/(?:($REG{phrase})?<$REG{FWS}($REG{obs_route})?$REG{FWS}($REG{addr_spec})$REG{FWS}>\|($REG{addr_spec}))/;
40	$REG{M_quoted_string} = qr/\x22((?:\x5C[\x00-\xFF]\|[\x00-\x0C\x0E-\x21\x23-\x5B\x5D-\xFF])*)\x22/;
41
42	$REG{NON_atom} = qr/[^\x09\x20\x21\x23-\x27\x2A\x2B\x2D\x2F\x30-\x39\x3D\x3F\x41-\x5A\x5E-\x7E]/;
43
44	=head2 Message::Field::Address->new ()
45
46	Return empty address object.
47
48	=cut
49
50	sub new ($) {
51	bless {type => '_ROOT'}, shift;
52	}
53
54	=head2 Message::Field::Address->parse ($unfolded_field_body)
55
56	Parse structured C<field-body> contain of C<address-list>.
57
58	=cut
59
60	sub parse ($$) {
61	my $self = bless {}, shift;
62	my $field_body = shift;
63	$field_body = $self->delete_comment ($field_body);
64	my %addr = $self->parse_address_list ($field_body);
65	$self->{address} = $addr{address};
66	$self->{type} = $addr{type};
67	$self;
68	}
69
70	=head2 $self->address ()
71
72	Return address list in the format described in
73	L<$self-E<gt>parse_address_list ()>.
74
75	=cut
76
77	sub address ($) {@{shift->{address}}}
78
79	=head2 $self->add ($addr_spec, [%option])
80
81	Add an mail address to C<$self> (address object).
82	%option = (name => C<display-name>, route => C<route>,
83	group => C<display-name> of C<group>)
84
85	Note that this method (and other methods) does not check
86	$addr_spec and $option{route} is valid or not.
87
88	=cut
89
90	sub add ($$;%) {
91	my $self = shift;
92	my ($addr, %option) = @_;
93	my $name = $option{name} \|\| $option{display_name};
94	unless ($option{group}) {
95	push @{$self->{address}}, {type => 'mailbox',
96	addr_spec => $addr, display_name => $name, route => $option{route}};
97	} else {
98	for my $i (@{$self->{address}}) {
99	if ($i->{type} eq 'group' && $i->{display_name} eq $option{group}) {
100	push @{$i->{address}}, {type => 'mailbox',
101	addr_spec => $addr, display_name => $name, route => $option{route}};
102	return $self;
103	}
104	}
105	push @{$self->{address}}, {type => 'group', display_name => $option{group},
106	address => [
107	{type => 'mailbox',
108	addr_spec => $addr, display_name => $name, route => $option{route}}
109	]};
110	}
111	$self;
112	}
113
114	sub stringify ($) {
115	my $self = shift;
116	my @return;
117	for my $address (@{$self->{address}}) {
118	my $return = '';
119	next if !$address->{addr_spec} && $address->{type} ne 'group';
120	if ($address->{display_name}) {
121	$return = $self->quote_unsafe_string ($address->{display_name})
122	.($address->{type} eq 'group'? ': ': ' ');
123	}
124	if ($address->{type} ne 'group') {
125	$return .= '<'.$address->{route}.$address->{addr_spec}.'>';
126	} else {
127	my (@g_return);
128	for my $mailbox (@{$address->{address}}) {
129	next unless $mailbox->{addr_spec};
130	my $g_return = '';
131	$g_return = $self->quote_unsafe_string ($mailbox->{display_name}) .' '
132	if $mailbox->{display_name};
133	$g_return .= '<'.$mailbox->{route}.$mailbox->{addr_spec}.'>';
134	push @g_return, $g_return;
135	}
136	$return .= join ', ', @g_return;
137	$return .= ';' if $address->{type} eq 'group';
138	}
139	push @return, $return;
140	}
141	join ', ', @return;
142	}
143
144	sub quote_unsafe_string ($$) {
145	my $self = shift;
146	my $string = shift;
147	if ($string =~ /$REG{NON_atom}/ \|\| $string =~ /$REG{WSP}$REG{WSP}+/) {
148	$string =~ s/([\x22\x5C])/\x5C$1/g;
149	$string = '"'.$string.'"';
150	}
151	$string;
152	}
153
154	=head2 $self->unquote_quoted_string ($string)
155
156	Unquote C<quoted-string>. Get rid of C<DQUOTE>s and
157	C<REVERSED SOLIDUS> included in C<quoted-pair>.
158	This method is intended for internal use.
159
160	=cut
161
162	sub unquote_quoted_string ($$) {
163	my $self = shift;
164	my $quoted_string = shift;
165	$quoted_string =~ s{$REG{M_quoted_string}}{
166	my $qtext = $1;
167	$qtext =~ s/\x5C([\x00-\xFF])/$1/g;
168	$qtext;
169	}goex;
170	$quoted_string;
171	}
172
173	=head2 $self->parse_mailbox ($mailbox)
174
175	Parse C<mailbox> and return array of C<addr-spec>,
176	C<display-name> and C<route> (aka C<obs-route> of RFC 2822).
177	This method is intended for internal use.
178
179	=cut
180
181	sub parse_mailbox ($$) {
182	my $self = shift;
183	my $mailbox = shift;
184	if ($mailbox =~ /$REG{M_mailbox}/) {
185	my ($display_name, $route, $addr_spec) = ($1, $2, $3 \|\| $4);
186	$display_name =~ s/$REG{WSP}+$//;
187	$display_name = $self->unquote_quoted_string ($display_name);
188	$addr_spec =~ s{($REG{quoted_string}\|$REG{domain_literal})\|$REG{WSP}}{$1}go;
189	$route =~ s{($REG{quoted_string}\|$REG{domain_literal})\|$REG{WSP}}{$1}go;
190	return ($addr_spec, $display_name, $route);
191	}
192	}
193
194	=head2 $self->parse_address_list ($address_list)
195
196	Parse C<address-list> and return hash.
197	This method is intended for internal use.
198
199	=head3 Structure of hash returned by parse_address_list
200
201	%address = (
202
203	type => '_ROOT',
204	address => [
205
206	## mailbox
207	{
208	type => 'mailbox',
209	display_name => 'Foo H. Bar',
210	addr_spec => '[email protected]',
211	route => '@hoge.example:',
212	},
213
214	## group
215	{
216	type => 'group',
217	display_name => 'The committee',
218	address => [
219
220	## mailbox
221	{
222	type => 'mailbox',
223	display_name => 'Tom (Director)',
224	addr_spec => '[email protected]',
225	route => '',
226	}
227
228	],
229	},
230
231	],
232
233	);
234
235	=cut
236
237	sub parse_address_list ($$) {
238	my $self = shift;
239	my $address_list = shift;
240	my %r_addr = (type => '_ROOT');
241	$address_list =~ s{($REG{address})}{
242	my $address = $1;
243	if ($address =~ /^$REG{M_group}/) {
244	my %r_group = (type => 'group', display_name => $1);
245	$r_group{display_name} =~ s/$REG{WSP}+$//;
246	$r_group{display_name} = $self->unquote_quoted_string ($r_group{display_name});
247	$address =~ s{($REG{mailbox})}{
248	my ($addr, $name, $route) = $self->parse_mailbox ($1);
249	push @{$r_group{address}}, {type => 'mailbox',
250	display_name => $name, route => $route, addr_spec => $addr};
251	}goex;
252	push @{$r_addr{address}}, \%r_group;
253	} else {
254	my ($addr, $name, $route) = $self->parse_mailbox ($address);
255	push @{$r_addr{address}}, {type => 'mailbox',
256	display_name => $name, route => $route, addr_spec => $addr};
257	}
258	}goex;
259	%r_addr;
260	}
261
262	=head2 $self->delete_comment ($field_body)
263
264	Remove all C<comment> in given strictured C<field-body>.
265	This method is intended for internal use.
266
267	=cut
268
269	sub delete_comment ($$) {
270	my $self = shift;
271	my $body = shift;
272	$body =~ s{($REG{quoted_string}\|$REG{domain_literal})\|$REG{comment}}{
273	my $o = $1; $o? $o : ' ';
274	}gex;
275	$body;
276	}
277
278	=head1 EXAMPLE
279
280	## Compose field-body for To: field.
281
282	use Message::Field::Address;
283	my $addr = new Message::Field::Address;
284	$addr->add ('[email protected]', name => 'Mr. foo bar');
285	$addr->add ('[email protected]', group => 'administrators');
286	$addr->add ('[email protected]', group => 'administrators');
287
288	my $field_body = $addr->stringify ();
289
290
291	## Output parsed address-list tree.
292
293	use Message::Field::Address;
294	my $addr = Message::Field::Address->parse ($field_body);
295
296	for my $i (@$addr) {
297	if ($i->{type} eq 'group') {
298	print "\x40 $i->{display_name}: \n";
299	for my $j (@{$i->{address}}) {
300	print "\t- $j->{display_name} <$j->{route}$j->{addr_spec}>\n";
301	}
302	} else {
303	print "- $i->{display_name} <$i->{route}$i->{addr_spec}>\n";
304	}
305	}
306
307	=head1 LICENSE
308
309	Copyright 2002 wakaba E<lt>[email protected]<gt>.
310
311	This program is free software; you can redistribute it and/or modify
312	it under the terms of the GNU General Public License as published by
313	the Free Software Foundation; either version 2 of the License, or
314	(at your option) any later version.
315
316	This program is distributed in the hope that it will be useful,
317	but WITHOUT ANY WARRANTY; without even the implied warranty of
318	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
319	GNU General Public License for more details.
320
321	You should have received a copy of the GNU General Public License
322	along with this program; see the file COPYING. If not, write to
323	the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
324	Boston, MA 02111-1307, USA.
325
326	=head1 CHANGE
327
328	See F<ChangeLog>.
329	$Date: $
330
331	=cut
332
333	1;