Message/Field/Mailbox.pm


=head1 NAME

Message::Field::Mailbox --- A perl module for an Internet
mail address (mailbox) which is part of Internet Messages

=cut

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

%REG = %Message::Util::REG;
        $REG{sub_domain} = qr/$REG{atext}|$REG{domain_literal}/;
        $REG{domain} = qr/$REG{sub_domain}(?:$REG{FWS}\.$REG{FWS}$REG{sub_domain})*/;
        $REG{route} = qr/\x40$REG{FWS}$REG{domain}(?:[\x09\x20,]*\x40$REG{FWS}$REG{domain})*$REG{FWS}:/;
        $REG{SCM_angle_addr} = qr/<((?:$REG{quoted_string}|$REG{domain_literal}|$REG{comment}|[^\x22\x28\x5B\x3E])+)>|<>/;

=head1 CONSTRUCTORS

The following methods construct new objects:

=over 4

=cut

## Initialize of this class -- called by constructors
  %DEFAULT = (
    -_ARRAY_NAME        => 'route',
    -_ARRAY_VALTYPE     => 'domain',
    -_MEMBERS   => [qw|display_name route local_part domain keyword|],
    -_METHODS   => [qw|addr_spec display_name local_part domain keyword
                       have_group comment_add comment_delete comment_item
                       comment_count route_add route_count route_delete
                       route_item|],
    -allow_empty_addr_spec      => 0,
    -by => 'domain',
    -comment_to_display_name    => 1,
    -default_domain     => 'localhost',
    #encoding_after_encode
    #encoding_before_decode
    #-encoding_after_encode_domain      => 'unknown-8bit',
    #-encoding_before_decode_domain     => 'unknown-8bit',
    -encoding_after_encode_local_part   => 'unknown-8bit',
    -encoding_before_decode_local_part  => 'unknown-8bit',
    #field_param_name
    #field_name
    -fill_domain        => 1,
    #format
    #hook_encode_string
    #hook_decode_string
    -must_have_addr_spec        => 1,
    -output_angle_bracket       => 1,
    -output_comment     => 1,
    -output_display_name        => 1,
    -output_keyword     => 0,
    -output_route       => 0,
    -parse_all  => 1,   ## = parse_domain + parse_local_part
    -parse_domain       => 1,
    -parse_local_part   => 1,   ## not implemented.
    -unsafe_rule_display_name   => 'NON_http_attribute_char_wsp',
    -unsafe_rule_local_part     => 'NON_atext_dot',
    -unsafe_rule_keyword        => 'NON_atext_dot',
    -use_keyword        => 0,
  );
sub _init ($;%) {
  my $self = shift;
  my %options = @_;
  my $DEFAULT = Message::Util::make_clone (\%DEFAULT);
  $self->SUPER::_init (%$DEFAULT, %options);
  $self->{option}->{value_type}->{domain} = ['Message::Field::Domain', {
      #-encoding_after_encode => $self->{option}->{encoding_after_encode_domain},
      #-encoding_before_decode => $self->{option}->{encoding_before_decode_domain},
  },];
  
  my $format = $self->{option}->{format};
  my $field = $self->{option}->{field_name};
  if ($format =~ /mail-rfc822/) {
    $self->{option}->{output_route} = 1
      if $field eq 'from' || $field eq 'resent-from'
      || $field eq 'sender' || $field eq 'resent-sender'
      || $field eq 'to' || $field eq 'cc' || $field eq 'bcc'
      || $field eq 'resent-to' || $field eq 'resent-cc'
      || $field eq 'resent-bcc' || $field eq 'reply-to'
      || $field eq 'resent-reply-to' || $field eq 'return-path';
  }
  if ($field eq 'mail-copies-to') {
    $self->{option}->{use_keyword} = 1;
    $self->{option}->{output_keyword} = 1;
  }
  if ($field eq 'return-path') {
    $self->{option}->{allow_empty_addr_spec} = 1;
    $self->{option}->{output_display_name} = 0;
    $self->{option}->{output_comment} = 0;
        ## RFC [2]822 allows CFWS, but [2]821 does NOT.
  }
  if ($format =~ /http/) {
    $self->{option}->{unsafe_rule_local_part} = 'NON_http_attribute_char_wsp';
  }
}

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

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

=cut

## Inherited

=item $m = Message::Field::Mailbox->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 $body = shift;
  $self->_init (@_);
  ($body, @{$self->{comment}})
    = $self->Message::Util::delete_comment_to_array ($body);
  my $parse_lp = $self->{option}->{parse_local_part}
              || $self->{option}->{parse_all};
  my $parse_dm = $self->{option}->{parse_domain}
              || $self->{option}->{parse_all};
  my $addr_spec = '';
  if ($body =~ /([^\x3C]*)$REG{SCM_angle_addr}/) {
    my ($dn, $as) = ($1, $2);
    $dn =~ s/^$REG{WSP}+//;  $dn =~ s/$REG{WSP}+$//;
    $self->{display_name} = $self->Message::Util::decode_quoted_string ($dn);
    $addr_spec = Message::Util::remove_meaningless_wsp ($as);
  } elsif ($self->{option}->{use_keyword}
    && $body =~ /^$REG{FWS}($REG{atext_dot})$REG{FWS}$/) {
    #$self->{keyword} = Message::Util::remove_meaningless_wsp ($1);
    $self->{keyword} = $1;
    $self->{keyword} =~ tr/\x09\x20//d;
  } else {
    $addr_spec = Message::Util::remove_meaningless_wsp ($body);
  }
  if ($addr_spec =~ /^($REG{route})?((?:$REG{quoted_string}|[^\x22])+?)\x40((?:$REG{domain_literal}|[^\x5B\x40])+)$/) {
    my $route = $1;
    $self->{local_part} = $2; $self->{domain} = $3;
    $self->{domain} = $self->_parse_value ('domain' => $self->{domain})
      if $parse_dm;
    $route =~ s{\x40$REG{FWS}($REG{domain})}{
      my $d = $1;
      $d = $self->_parse_value ('domain' => $d) if $parse_dm;
      push @{$self->{route}}, $d;
    }gex;
  } elsif (length $addr_spec) {
    $self->{local_part} = $addr_spec;
  }
  #if ($parse_lp && $self->{local_part}) {}
  $self->{local_part}
    = $self->Message::Util::decode_quoted_string ($self->{local_part}, 
      type => 'word',
      charset => $self->{option}->{encoding_before_decode_local_part});
  $self;
}

sub display_name ($;$) {
  my $self = shift;
  my $newdn = shift;
  $self->{display_name} = $newdn if defined $newdn;
  $self->{display_name};
}

sub local_part ($;$) {
  my $self = shift;
  my $newlp = shift;
  $self->{local_part} = $newlp if defined $newlp;
  $self->{local_part};
}

sub domain ($;$) {
  my $self = shift;
  my $newdomain = shift;
  if (defined $newdomain) {
    $newdomain = $self->_parse_value ('domain' => $newdomain)
      if $self->{option}->{parse_domain} || $self->{option}->{parse_all};
    $self->{domain} = $newdomain;
  }
  $self->{domain};
}

sub keyword ($;$) {
  my $self = shift;
  return unless $self->{option}->{use_keyword};
  my $newkey = shift;
  $self->{keyword} = $newkey if defined $newkey;
  $self->{keyword};
}

sub route_add ($@) {shift->SUPER::add (@_)}
sub route_count ($@) {shift->SUPER::count (@_)}
sub route_delete ($@) {shift->SUPER::delete (@_)}
sub route_item ($@) {shift->SUPER::item (@_)}

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 'domain') {
    $$i = $self->_parse_value ('domain' => $$i);
    return 1 if $list->{$$i};
  }
  0;
}
*_item_match = \&_delete_match;

## Returns returned item value    \$item-value, \%option
sub _item_return_value ($\$\%) {
  if (ref ${$_[1]}) {
    ${$_[1]};
  } else {
    ${$_[1]} = $_[0]->_parse_value (domain => ${$_[1]});
    ${$_[1]};
  }
}
sub _item_new_value ($$\%) {
  $_[0]->_parse_value (domain => $_[2]->{by} eq 'domain'?$_[1]:'');
}

sub have_group ($) {0}

sub addr_spec ($;%) {
  my $self = shift;
  my %o = (
    -output_angle_bracket       => 0,
    -output_comment     => 0,
    -output_display_name        => 0,
    -output_keyword     => 0,
    -output_route       => 0,
  );
  $self->stringify (%o, @_);
}

sub stringify ($;%) {
  my $self = shift;
  my %o = @_;  my %option = %{$self->{option}};
  for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
  my ($dn, $as, $cm) = ('', '', '');
  if (length $self->{keyword}) {
    if ($option{output_keyword}) {
      my %s = &{$option{hook_encode_string}} ($self, 
              $self->{keyword}, type => 'phrase');
      $as = Message::Util::quote_unsafe_string
          ($s{value}, unsafe => $option{unsafe_rule_keyword});
    } else {
      $as = '('. $self->Message::Util::encode_ccontent ($self->{keyword}) .')';
    }
  } else {
    if ($option{output_display_name}) {
      if (length $self->{display_name}) {
        my %s = &{$option{hook_encode_string}} ($self, 
            $self->{display_name}, type => 'phrase');
        $dn = Message::Util::quote_unsafe_string
            ($s{value}, unsafe => $option{unsafe_rule_display_name}) . ' ';
      } elsif ($option{comment_to_display_name}) {
        my $fullname = shift (@{$self->{comment}});
        if (length $fullname) {
          my %s = &{$option{hook_encode_string}} ($self, 
            $fullname, type => 'phrase');
          $dn = Message::Util::quote_unsafe_string
            ($s{value}, unsafe => $option{unsafe_rule_display_name}) . ' ';
        }
      }
    } elsif ($option{output_comment} && length $self->{display_name}) {
      $dn = ' ('. $self->Message::Util::encode_ccontent ($self->{display_name}) .')';
    }
    my %s = &{$option{hook_encode_string}} ($self, 
          $self->{local_part}, type => 'word',
          charset => $option{encoding_after_encode_local_part});
    $as = Message::Util::quote_unsafe_string ($s{value}, 
            unsafe => $option{unsafe_rule_local_part});
    my $d = '' . $self->{domain};
    $d ||= $option{default_domain} if $option{fill_domain};
    $as .= '@' . $d if length $d && length $as;
    if ($as) {
      if ($option{output_angle_bracket}) {
        if ($option{output_route}) {
          my $route = join ',', grep {$_ ne '@'}
            map {'@'.$_} @{$self->{route}};
          $as = $route . ':' . $as if $route;
        }
        $as = '<' . $as . '>';
      }
    } else {
      $as = '<>' if $option{allow_empty_addr_spec}
                 && $option{output_angle_bracket};
      return '' if !$option{allow_empty_addr_spec}
                 && $option{must_have_addr_spec};
    }
  }
  if ($option{output_comment}) {
    $cm = $self->_comment_stringify (\%option);
    $cm = ' ' . $cm if $cm;
    if ($dn && !$option{output_display_name}) {
      $cm = $dn . $cm;  $dn = '';
    }
  }
  $dn . $as . $cm;
}
*as_string = \&stringify;

=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/05/17 05:42:27 $

=cut

1;
1	wakaba	1.1
2			=head1 NAME
3
4			Message::Field::Mailbox --- A perl module for an Internet
5			mail address (mailbox) which is part of Internet Messages
6
7			=cut
8
9			package Message::Field::Mailbox;
10			require 5.6.0;
11			use strict;
12			use re 'eval';
13			use vars qw(%DEFAULT @ISA %REG $VERSION);
14	wakaba	1.4	$VERSION=do{my @r=(q$Revision: 1.3 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
15	wakaba	1.1	require Message::Field::Structured;
16			push @ISA, qw(Message::Field::Structured);
17
18			%REG = %Message::Util::REG;
19			$REG{sub_domain} = qr/$REG{atext}\|$REG{domain_literal}/;
20			$REG{domain} = qr/$REG{sub_domain}(?:$REG{FWS}\.$REG{FWS}$REG{sub_domain})*/;
21			$REG{route} = qr/\x40$REG{FWS}$REG{domain}(?:[\x09\x20,]\x40$REG{FWS}$REG{domain})$REG{FWS}:/;
22			$REG{SCM_angle_addr} = qr/<((?:$REG{quoted_string}\|$REG{domain_literal}\|$REG{comment}\|[^\x22\x28\x5B\x3E])+)>\|<>/;
23
24			=head1 CONSTRUCTORS
25
26			The following methods construct new objects:
27
28			=over 4
29
30			=cut
31
32			## Initialize of this class -- called by constructors
33			%DEFAULT = (
34			-_ARRAY_NAME => 'route',
35			-_ARRAY_VALTYPE => 'domain',
36	wakaba	1.2	-_MEMBERS => [qw\|display_name route local_part domain keyword\|],
37			-_METHODS => [qw\|addr_spec display_name local_part domain keyword
38			have_group comment_add comment_delete comment_item
39			comment_count route_add route_count route_delete
40			route_item\|],
41	wakaba	1.1	-allow_empty_addr_spec => 0,
42			-by => 'domain',
43			-comment_to_display_name => 1,
44			-default_domain => 'localhost',
45			#encoding_after_encode
46			#encoding_before_decode
47			#-encoding_after_encode_domain => 'unknown-8bit',
48			#-encoding_before_decode_domain => 'unknown-8bit',
49			-encoding_after_encode_local_part => 'unknown-8bit',
50			-encoding_before_decode_local_part => 'unknown-8bit',
51			#field_param_name
52			#field_name
53			-fill_domain => 1,
54			#format
55			#hook_encode_string
56			#hook_decode_string
57			-must_have_addr_spec => 1,
58			-output_angle_bracket => 1,
59			-output_comment => 1,
60			-output_display_name => 1,
61	wakaba	1.2	-output_keyword => 0,
62	wakaba	1.1	-output_route => 0,
63			-parse_all => 1, ## = parse_domain + parse_local_part
64			-parse_domain => 1,
65			-parse_local_part => 1, ## not implemented.
66	wakaba	1.3	-unsafe_rule_display_name => 'NON_http_attribute_char_wsp',
67			-unsafe_rule_local_part => 'NON_atext_dot',
68			-unsafe_rule_keyword => 'NON_atext_dot',
69	wakaba	1.1	-use_keyword => 0,
70			);
71			sub _init ($;%) {
72			my $self = shift;
73			my %options = @_;
74			my $DEFAULT = Message::Util::make_clone (\%DEFAULT);
75			$self->SUPER::_init (%$DEFAULT, %options);
76	wakaba	1.3	$self->{option}->{value_type}->{domain} = ['Message::Field::Domain', {
77	wakaba	1.1	#-encoding_after_encode => $self->{option}->{encoding_after_encode_domain},
78			#-encoding_before_decode => $self->{option}->{encoding_before_decode_domain},
79			},];
80
81			my $format = $self->{option}->{format};
82	wakaba	1.3	my $field = $self->{option}->{field_name};
83	wakaba	1.1	if ($format =~ /mail-rfc822/) {
84	wakaba	1.2	$self->{option}->{output_route} = 1
85	wakaba	1.1	if $field eq 'from' \|\| $field eq 'resent-from'
86			\|\| $field eq 'sender' \|\| $field eq 'resent-sender'
87			\|\| $field eq 'to' \|\| $field eq 'cc' \|\| $field eq 'bcc'
88			\|\| $field eq 'resent-to' \|\| $field eq 'resent-cc'
89			\|\| $field eq 'resent-bcc' \|\| $field eq 'reply-to'
90			\|\| $field eq 'resent-reply-to' \|\| $field eq 'return-path';
91			}
92	wakaba	1.3	if ($field eq 'mail-copies-to') {
93	wakaba	1.1	$self->{option}->{use_keyword} = 1;
94	wakaba	1.2	$self->{option}->{output_keyword} = 1;
95	wakaba	1.1	}
96	wakaba	1.3	if ($field eq 'return-path') {
97	wakaba	1.1	$self->{option}->{allow_empty_addr_spec} = 1;
98			$self->{option}->{output_display_name} = 0;
99			$self->{option}->{output_comment} = 0;
100			## RFC [2]822 allows CFWS, but [2]821 does NOT.
101			}
102	wakaba	1.3	if ($format =~ /http/) {
103			$self->{option}->{unsafe_rule_local_part} = 'NON_http_attribute_char_wsp';
104			}
105	wakaba	1.1	}
106
107	wakaba	1.3	=item $m = Message::Field::Mailbox->new ([%options])
108	wakaba	1.1
109			Constructs a new object. You might pass some options as parameters
110			to the constructor.
111
112			=cut
113
114			## Inherited
115
116	wakaba	1.3	=item $m = Message::Field::Mailbox->parse ($field-body, [%options])
117	wakaba	1.1
118			Constructs a new object with given field body. You might pass
119			some options as parameters to the constructor.
120
121			=cut
122
123			sub parse ($$;%) {
124			my $class = shift;
125			my $self = bless {}, $class;
126			my $body = shift;
127			$self->_init (@_);
128			($body, @{$self->{comment}})
129			= $self->Message::Util::delete_comment_to_array ($body);
130			my $parse_lp = $self->{option}->{parse_local_part}
131			\|\| $self->{option}->{parse_all};
132			my $parse_dm = $self->{option}->{parse_domain}
133			\|\| $self->{option}->{parse_all};
134			my $addr_spec = '';
135			if ($body =~ /([^\x3C]*)$REG{SCM_angle_addr}/) {
136			my ($dn, $as) = ($1, $2);
137	wakaba	1.3	$dn =~ s/^$REG{WSP}+//; $dn =~ s/$REG{WSP}+$//;
138	wakaba	1.1	$self->{display_name} = $self->Message::Util::decode_quoted_string ($dn);
139			$addr_spec = Message::Util::remove_meaningless_wsp ($as);
140			} elsif ($self->{option}->{use_keyword}
141			&& $body =~ /^$REG{FWS}($REG{atext_dot})$REG{FWS}$/) {
142			#$self->{keyword} = Message::Util::remove_meaningless_wsp ($1);
143			$self->{keyword} = $1;
144			$self->{keyword} =~ tr/\x09\x20//d;
145			} else {
146			$addr_spec = Message::Util::remove_meaningless_wsp ($body);
147			}
148			if ($addr_spec =~ /^($REG{route})?((?:$REG{quoted_string}\|[^\x22])+?)\x40((?:$REG{domain_literal}\|[^\x5B\x40])+)$/) {
149			my $route = $1;
150			$self->{local_part} = $2; $self->{domain} = $3;
151			$self->{domain} = $self->_parse_value ('domain' => $self->{domain})
152			if $parse_dm;
153			$route =~ s{\x40$REG{FWS}($REG{domain})}{
154			my $d = $1;
155			$d = $self->_parse_value ('domain' => $d) if $parse_dm;
156			push @{$self->{route}}, $d;
157			}gex;
158			} elsif (length $addr_spec) {
159			$self->{local_part} = $addr_spec;
160			}
161			#if ($parse_lp && $self->{local_part}) {}
162			$self->{local_part}
163			= $self->Message::Util::decode_quoted_string ($self->{local_part},
164			type => 'word',
165			charset => $self->{option}->{encoding_before_decode_local_part});
166			$self;
167			}
168
169	wakaba	1.4	sub display_name ($;$) {
170			my $self = shift;
171			my $newdn = shift;
172			$self->{display_name} = $newdn if defined $newdn;
173			$self->{display_name};
174			}
175
176	wakaba	1.1	sub local_part ($;$) {
177			my $self = shift;
178			my $newlp = shift;
179			$self->{local_part} = $newlp if defined $newlp;
180			$self->{local_part};
181			}
182
183			sub domain ($;$) {
184			my $self = shift;
185			my $newdomain = shift;
186			if (defined $newdomain) {
187			$newdomain = $self->_parse_value ('domain' => $newdomain)
188			if $self->{option}->{parse_domain} \|\| $self->{option}->{parse_all};
189			$self->{domain} = $newdomain;
190			}
191			$self->{domain};
192			}
193
194			sub keyword ($;$) {
195			my $self = shift;
196			return unless $self->{option}->{use_keyword};
197			my $newkey = shift;
198			$self->{keyword} = $newkey if defined $newkey;
199			$self->{keyword};
200			}
201
202			sub route_add ($@) {shift->SUPER::add (@_)}
203			sub route_count ($@) {shift->SUPER::count (@_)}
204			sub route_delete ($@) {shift->SUPER::delete (@_)}
205			sub route_item ($@) {shift->SUPER::item (@_)}
206
207			sub _delete_match ($$$\%\%) {
208			my $self = shift;
209			my ($by, $i, $list, $option) = @_;
210			return 0 unless ref $$i; ## Already removed
211			return 0 if $$option{type} && $$i->{type} ne $$option{type};
212			if ($by eq 'domain') {
213			$$i = $self->_parse_value ('domain' => $$i);
214			return 1 if $list->{$$i};
215			}
216			0;
217			}
218			*_item_match = \&_delete_match;
219
220			## Returns returned item value \$item-value, \%option
221			sub _item_return_value ($\$\%) {
222			if (ref ${$_[1]}) {
223			${$_[1]};
224			} else {
225			${$_[1]} = $_[0]->_parse_value (domain => ${$_[1]});
226			${$_[1]};
227			}
228			}
229			sub _item_new_value ($$\%) {
230			$_[0]->_parse_value (domain => $_[2]->{by} eq 'domain'?$_[1]:'');
231			}
232
233	wakaba	1.2	sub have_group ($) {0}
234
235			sub addr_spec ($;%) {
236			my $self = shift;
237			my %o = (
238			-output_angle_bracket => 0,
239			-output_comment => 0,
240			-output_display_name => 0,
241			-output_keyword => 0,
242			-output_route => 0,
243			);
244			$self->stringify (%o, @_);
245			}
246
247	wakaba	1.1	sub stringify ($;%) {
248			my $self = shift;
249			my %o = @_; my %option = %{$self->{option}};
250			for (grep {/^-/} keys %o) {$option{substr ($_, 1)} = $o{$_}}
251			my ($dn, $as, $cm) = ('', '', '');
252			if (length $self->{keyword}) {
253			if ($option{output_keyword}) {
254			my %s = &{$option{hook_encode_string}} ($self,
255			$self->{keyword}, type => 'phrase');
256			$as = Message::Util::quote_unsafe_string
257	wakaba	1.3	($s{value}, unsafe => $option{unsafe_rule_keyword});
258	wakaba	1.1	} else {
259			$as = '('. $self->Message::Util::encode_ccontent ($self->{keyword}) .')';
260			}
261			} else {
262			if ($option{output_display_name}) {
263			if (length $self->{display_name}) {
264			my %s = &{$option{hook_encode_string}} ($self,
265			$self->{display_name}, type => 'phrase');
266			$dn = Message::Util::quote_unsafe_string
267	wakaba	1.3	($s{value}, unsafe => $option{unsafe_rule_display_name}) . ' ';
268	wakaba	1.1	} elsif ($option{comment_to_display_name}) {
269			my $fullname = shift (@{$self->{comment}});
270			if (length $fullname) {
271			my %s = &{$option{hook_encode_string}} ($self,
272			$fullname, type => 'phrase');
273			$dn = Message::Util::quote_unsafe_string
274	wakaba	1.3	($s{value}, unsafe => $option{unsafe_rule_display_name}) . ' ';
275	wakaba	1.1	}
276			}
277			} elsif ($option{output_comment} && length $self->{display_name}) {
278			$dn = ' ('. $self->Message::Util::encode_ccontent ($self->{display_name}) .')';
279			}
280			my %s = &{$option{hook_encode_string}} ($self,
281			$self->{local_part}, type => 'word',
282			charset => $option{encoding_after_encode_local_part});
283			$as = Message::Util::quote_unsafe_string ($s{value},
284	wakaba	1.3	unsafe => $option{unsafe_rule_local_part});
285	wakaba	1.1	my $d = '' . $self->{domain};
286			$d \|\|= $option{default_domain} if $option{fill_domain};
287			$as .= '@' . $d if length $d && length $as;
288			if ($as) {
289			if ($option{output_angle_bracket}) {
290			if ($option{output_route}) {
291			my $route = join ',', grep {$_ ne '@'}
292			map {'@'.$_} @{$self->{route}};
293			$as = $route . ':' . $as if $route;
294			}
295			$as = '<' . $as . '>';
296			}
297			} else {
298			$as = '<>' if $option{allow_empty_addr_spec}
299			&& $option{output_angle_bracket};
300			return '' if !$option{allow_empty_addr_spec}
301			&& $option{must_have_addr_spec};
302			}
303			}
304			if ($option{output_comment}) {
305			$cm = $self->_comment_stringify (\%option);
306			$cm = ' ' . $cm if $cm;
307			if ($dn && !$option{output_display_name}) {
308			$cm = $dn . $cm; $dn = '';
309			}
310			}
311			$dn . $as . $cm;
312			}
313	wakaba	1.3	*as_string = \&stringify;
314	wakaba	1.1
315			=head1 LICENSE
316
317			Copyright 2002 wakaba E<lt>w@suika.fam.cxE<gt>.
318
319			This program is free software; you can redistribute it and/or modify
320			it under the terms of the GNU General Public License as published by
321			the Free Software Foundation; either version 2 of the License, or
322			(at your option) any later version.
323
324			This program is distributed in the hope that it will be useful,
325			but WITHOUT ANY WARRANTY; without even the implied warranty of
326			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
327			GNU General Public License for more details.
328
329			You should have received a copy of the GNU General Public License
330			along with this program; see the file COPYING. If not, write to
331			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
332			Boston, MA 02111-1307, USA.
333
334			=head1 CHANGE
335
336			See F<ChangeLog>.
337	wakaba	1.4	$Date: 2002/05/17 05:42:27 $
338	wakaba	1.1
339			=cut
340
341			1;