/[suikacvs]/messaging/manakai/lib/Message/Entity.pm
Suika

Diff of /messaging/manakai/lib/Message/Entity.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by wakaba, Sun Jul 7 00:46:07 2002 UTC revision 1.35 by wakaba, Sun Jul 28 00:31:38 2002 UTC
# Line 28  use overload '""' => sub { $_[0]->string Line 28  use overload '""' => sub { $_[0]->string
28      -_MEMBERS   => [qw|header body _cte|],      -_MEMBERS   => [qw|header body _cte|],
29          ## entity_header -- Don't clone.          ## entity_header -- Don't clone.
30      -accept_coderange   => '7bit',      ## 7bit / 8bit / binary      -accept_coderange   => '7bit',      ## 7bit / 8bit / binary
     #add_ua     => 1,  
31      -body_default_charset       => 'iso-2022-int-1',      -body_default_charset       => 'iso-2022-int-1',
32      -body_default_charset_input => 'iso-2022-int-1',      -body_default_charset_input => 'iso-2022-int-1',
33      -body_default_media_type    => 'text',      -body_default_media_type    => 'text',
34      -body_default_media_subtype => 'plain',      -body_default_media_subtype => 'plain',
35      -cte_default        => '7bit',      -cte_default        => '7bit',
36      #fill_date  => 1,      -fill_missing_fields        => 1,
37      -fill_date_name     => 'date',          #add_ua => 1,
38      -fill_md5   => 0,          #fill_date      => 1,
39      -fill_md5_name      => 'md5',          -fill_date_name => 'date',
40      #fill_msgid => 1,          -fill_destination       => 0,
41      -fill_msgid_name    => 'message-id',          #fill_destination_ns
42            #fill_destination_resent_ns
43            #fill_from_ns
44            -fill_md5       => 0,
45            -fill_md5_name  => 'md5',
46            #fill_msgid     => 1,
47            -fill_msgid_name        => 'message-id',
48            #fill_sender_ns
49            -fill_source    => 1,
50            -recalc_md5     => 1,
51      -force_mime_entity  => 0,      -force_mime_entity  => 0,
52      -format     => 'mail-rfc2822',      -format     => 'mail-rfc2822',
53        -guess_media_type   => 1,
54        #internal_charset_name
55      -header_default_charset     => 'iso-2022-int-1',      -header_default_charset     => 'iso-2022-int-1',
56      -header_default_charset_input       => 'iso-2022-int-1',      -header_default_charset_input       => 'iso-2022-int-1',
57        -hook_init_fill_options     => sub {},
58      -linebreak_strict   => 0,   ## BUG: not work perfectly      -linebreak_strict   => 0,   ## BUG: not work perfectly
59      -parse_all  => 0,      -parse_all  => 0,
     -recalc_md5 => 1,  
60      -text_coderange     => 'binary',      -text_coderange     => 'binary',
61          ## '8bit' (MIME text/*) / 'binary' (HTTP text/*)          ## '8bit' (MIME text/*) / 'binary' (HTTP text/*)
62      #ua_field_name      => 'user-agent',      #ua_field_name      => 'user-agent',
# Line 79  sub _init ($;%) { Line 89  sub _init ($;%) {
89    my $format = $self->{option}->{format};    my $format = $self->{option}->{format};
90    if ($format =~ /http/) {    if ($format =~ /http/) {
91      $self->{option}->{fill_date_ns}       = $Message::Header::NS_phname2uri{'x-http'};      $self->{option}->{fill_date_ns}       = $Message::Header::NS_phname2uri{'x-http'};
92        $self->{option}->{fill_from_ns}       = $Message::Header::NS_phname2uri{'x-http'};
93      $self->{option}->{fill_msgid_from_ns} = $Message::Header::NS_phname2uri{'x-http'};      $self->{option}->{fill_msgid_from_ns} = $Message::Header::NS_phname2uri{'x-http'};
94      $self->{option}->{fill_ua_ns}         = $Message::Header::NS_phname2uri{'x-http'};      $self->{option}->{fill_ua_ns}         = $Message::Header::NS_phname2uri{'x-http'};
95      $self->{option}->{accept_coderange} = 'binary';      $self->{option}->{accept_coderange} = 'binary';
96      $self->{option}->{text_coderange} = 'binary';      $self->{option}->{text_coderange} = 'binary';
97      $self->{option}->{cte_default} = 'binary';      $self->{option}->{cte_default} = 'binary';
98    } else {    } else {
99        if ($format =~ /mail-rfc822|mail-rfc2822/) {
100          $self->{option}->{fill_destination} = 1;
101        }
102      $self->{option}->{fill_date_ns}       = $Message::Header::NS_phname2uri{'x-rfc822'};      $self->{option}->{fill_date_ns}       = $Message::Header::NS_phname2uri{'x-rfc822'};
103        $self->{option}->{fill_from_ns}       = $Message::Header::NS_phname2uri{'x-rfc822'};
104      $self->{option}->{fill_msgid_from_ns} = $Message::Header::NS_phname2uri{'x-rfc822'};      $self->{option}->{fill_msgid_from_ns} = $Message::Header::NS_phname2uri{'x-rfc822'};
105      $self->{option}->{fill_ua_ns}         = $Message::Header::NS_phname2uri{'x-rfc822'};      $self->{option}->{fill_ua_ns}         = $Message::Header::NS_phname2uri{'x-rfc822'};
106      $self->{option}->{text_coderange} = '8bit';      $self->{option}->{text_coderange} = '8bit';
# Line 96  sub _init ($;%) { Line 111  sub _init ($;%) {
111        $self->{option}->{accept_coderange} = '7bit';        $self->{option}->{accept_coderange} = '7bit';
112      }      }
113    }    }
114    $self->{option}->{fill_msgid_ns}   = $Message::Header::NS_phname2uri{'x-rfc822'};    for (qw/fill_msgid_ns fill_mimever_ns fill_destination_ns fill_sender_ns/) {
115    $self->{option}->{fill_mimever_ns} = $Message::Header::NS_phname2uri{'x-rfc822'};      $self->{option}->{$_} = $Message::Header::NS_phname2uri{'x-rfc822'};
116      }
117      $self->{option}->{fill_destination_resent_ns} = $Message::Header::NS_phname2uri{'x-rfc822-resent'};
118    unless (defined $self->{option}->{fill_date}) {    unless (defined $self->{option}->{fill_date}) {
119      $self->{option}->{fill_date} = $format !~ /mime-entity|cgi|uri-url-mailto/;      $self->{option}->{fill_date} = $format !~ /mime-entity|cgi|uri-url-mailto/;
120    }    }
# Line 117  sub _init ($;%) { Line 134  sub _init ($;%) {
134      $self->{option}->{fill_ua_name} = $format =~ /response|cgi|uri-url-mailto/?      $self->{option}->{fill_ua_name} = $format =~ /response|cgi|uri-url-mailto/?
135        'server': 'user-agent';        'server': 'user-agent';
136    }    }
137      &{ $self->{option}->{hook_init_fill_options} } ($self, $self->{option});
138    @new_fields;    @new_fields;
139  }  }
140    
# Line 173  sub parse ($$;%) { Line 191  sub parse ($$;%) {
191    my $self = bless {}, $class;    my $self = bless {}, $class;
192    my %new_field = $self->_init (@_);    my %new_field = $self->_init (@_);
193    my $nl = "\x0D\x0A";    my $nl = "\x0D\x0A";
194    unless ($self->{option}->{strict_linebreak}) {    unless ($self->{option}->{linebreak_strict}) {
195      $nl = Message::Util::decide_newline ($message);      $nl = Message::Util::decide_newline ($message);
196    }    }
197    ## BUG: binary unsafe yet!    ## BUG: binary unsafe yet!
# Line 276  sub md5_check ($) { Line 294  sub md5_check ($) {
294    }    }
295    my $MD5;    my $MD5;
296    eval q{    eval q{
297          require Digest::MD5;  require MIME::Base64;      require Digest::MD5;
298          $MD5 = MIME::Base64::encode (Digest::MD5::md5 ($self->{body}));      $MD5 = ($self->Message::MIME::Encoding::encode_base64 (Digest::MD5::md5 ($self->{body})))[0];
299          $MD5 =~ tr/\x09\x0A\x0D\x20//d;      $MD5 =~ tr/\x09\x0A\x0D\x20//d;
300    } or Carp::croak $@;    1} or Carp::croak $@;
301    return $MD5 eq $md5? 1 : 0;    return $MD5 eq $md5? 1 : 0;
302  }  }
303    
# Line 307  sub _parse_value ($$$) { Line 325  sub _parse_value ($$$) {
325    my $vtype = $handler->[0];    my $vtype = $handler->[0];
326    my %vopt = (    my %vopt = (
327      -format     => $self->{option}->{format},      -format     => $self->{option}->{format},
328        -linebreak_strict   => $self->{option}->{linebreak_strict},
329      -media_type => $mt,      -media_type => $mt,
330      -media_subtype      => $mst,      -media_subtype      => $mst,
331      -parse_all  => $self->{option}->{parse_all},      -parse_all  => $self->{option}->{parse_all},
332      -body_default_charset       => $self->{option}->{body_default_charset},      -body_default_charset       => $self->{option}->{body_default_charset},
333      -body_default_charset_input => $self->{option}->{body_default_charset_input},      -body_default_charset_input => $self->{option}->{body_default_charset_input},
334        -internal_charset_name      => $self->{option}->{internal_charset_name},
335      entity_header       => $self->{header},      entity_header       => $self->{header},
336    );    );
337    ## Media type specified option/parameters    ## Media type specified option/parameters
# Line 384  sub _encode_body ($$\%) { Line 404  sub _encode_body ($$\%) {
404                $charset_def = $Message::MIME::Charset::CHARSET{$charset};                $charset_def = $Message::MIME::Charset::CHARSET{$charset};
405              } else {              } else {
406                $charset_def = $Message::MIME::Charset::CHARSET{'*default'};                $charset_def = $Message::MIME::Charset::CHARSET{'*default'};
407                ## Note: 'encoding_after_encode' option (available for header                ## Note: 'encoding_after_encode' option's value is hardcoded.
               ## field, but not for message body) is hardcoded.  
408              }              }
409            } else {      ## Don't have mime style "charset" parameter            } else {      ## Don't have mime style "charset" parameter
410              $charset_def = {mime_text => 1};              $charset_def = {mime_text => 1};
411            }            }
412            $charset_def = {} unless ref $charset_def;    ## dummy            $charset_def = {} unless ref $charset_def;    ## dummy
413            if ($charset_def->{mime_text} != 1) {            #if ($charset_def->{mime_text} != 1) {        ## See also Note above
414              if (Message::MIME::Charset::is_mime_text ($charset || '*default') != 1) {
415              $enoption{mt_is_text} = 0 if $mt eq 'text';              $enoption{mt_is_text} = 0 if $mt eq 'text';
416              my $ct = $self->{header}->field ('content-type');              my $ct = $self->{header}->field ('content-type');
417              $ct->not_mime_text ($option->{text_coderange} eq 'binary'? 0:1);              $ct->not_mime_text ($option->{text_coderange} eq 'binary'? 0:1);
# Line 478  sub stringify ($;%) { Line 498  sub stringify ($;%) {
498    my ($header, $body, $body0);    my ($header, $body, $body0);
499    if (ref $self->{body}) {    if (ref $self->{body}) {
500      $self->{body}->entity_header ($self->{header});      $self->{body}->entity_header ($self->{header});
501      $body0 = $self->{body}->stringify (-format => $option{format},      $body0 = $self->{body}->stringify (-parent_format => $option{format},
502        -linebreak_strict => $option{linebreak_strict});        -linebreak_strict => $option{linebreak_strict});
503    } else {    } else {
504      $body0 = $self->{body};      $body0 = $self->{body};
505    }    }
506    $body = $self->_encode_body ($body0, \%option);    $body = $self->_encode_body ($body0, \%option);
507    if (ref $self->{header}) {    if (ref $self->{header}) {
     my %exist;  
     for ($self->{header}->field_name_list) {$exist{$_} = 1}  
508      my $ns_content = $Message::Header::NS_phname2uri{content};      my $ns_content = $Message::Header::NS_phname2uri{content};
509      if ($option{fill_date}      my $filler;
510         && !$exist{$option{fill_date_name}.':'.$option{fill_date_ns}}) {      $filler = sub {
511        $self->{header}->field        my ($hdr, $exist, $hdr_option) = @_;
512          ($option{fill_date_name}, -ns => $option{fill_date_ns})->unix_time (time);        ## Date: (RFC 822, HTTP)
513      }        if ($option{fill_date}
514      if ($option{fill_msgid}           && !$exist->{$option{fill_date_name}.':'.$option{fill_date_ns}}) {
515         && !$exist{$option{fill_msgid_name}.':'.$option{fill_msgid_ns}}) {          $hdr->field
516        my $from = $self->{header}->field            ($option{fill_date_name}, -ns => $option{fill_date_ns})->unix_time (time);
         ('from', -ns => $option{fill_msgid_from_ns}, -new_item_unless_exist => 0);  
       $from = $from->addr_spec if ref $from;  
       $self->{header}->field  
         ($option{fill_msgid_name}, -ns => $option{fill_msgid_ns})  
         ->generate (addr_spec => $from)  
         if $from;  
     }   # fill_msgid  
     if (($option{fill_md5} && !$exist{ $option{fill_md5_name} .':'. $ns_content})  
      || ($option{recalc_md5} && $exist{ $option{fill_md5_name} .':'. $ns_content})) {  
       my $md5;  
       eval q{  
         require Digest::MD5;  require MIME::Base64;  
         $md5 = MIME::Base64::encode (Digest::MD5::md5 ($body0));  
         $md5 =~ tr/\x09\x0A\x0D\x20//d;  
       } or Carp::carp $@;  
       if ($md5) {  
         my $md5f = $self->{header}->field ($option{fill_md5_name}, -ns => $ns_content);  
         $md5f->value ($md5);  
517        }        }
518      }        ## Message-ID: (RFC 822)
519      my $ismime = 0;        if ($option{fill_msgid}
520      for (keys %exist) {if (/:$ns_content$/) { $ismime = 1; last }}           && !$exist->{$option{fill_msgid_name}.':'.$option{fill_msgid_ns}}) {
521      unless ($ismime) {          my $from = $hdr->field
522        $ismime = 1 if $option{force_mime_entity};            ('from', -ns => $option{fill_msgid_from_ns}, -new_item_unless_exist => 0);
523        $ismime = 1 if $option{fill_md5};          $from = $from->addr_spec if ref $from;
524        $ismime = 1 if $option{body_default_media_type} ne 'text';          $hdr->field ($option{fill_msgid_name}, -ns => $option{fill_msgid_ns})
525        $ismime = 1 if $option{body_default_media_subtype} ne 'plain';              ->generate (addr_spec => $from) if $from;
526      }        } # fill_msgid
527      if ($ismime) {        ## To:, CC:, BCC:, Resent-To:, Resent-Cc:, Resent-Bcc: (RFC 822)
528        if ($option{fill_ct} && !$exist{'type:'.$ns_content}) {        if ($option{fill_destination}) {
529            my $ct = $self->{header}->field ('type',          if ( !$exist->{ 'to:'.$option{fill_destination_ns} }
530              -parse => 1, -ns => $ns_content);            && !$exist->{ 'cc:'.$option{fill_destination_ns} }
531            $ct->media_type ($option{body_default_media_type}.'/'            && !$exist->{ 'bcc:'.$option{fill_destination_ns} }
532                            .$option{body_default_media_subtype});            && !$exist->{ 'to:'.$option{fill_destination_resent_ns} }
533            $ct->replace (Message::MIME::Charset::name_minimumize ($option{body_default_charset} => $body0));            && !$exist->{ 'cc:'.$option{fill_destination_resent_ns} }
534              && !$exist->{ 'bcc:'.$option{fill_destination_resent_ns} } ) {
535              $hdr->add (bcc => '');
536            }
537          }
538          ## From:, Sender:
539          if ($option{fill_source}) {
540            ## From:
541            if (!$exist->{ 'from:'.$option{fill_from_ns} }) {
542              $hdr->add (from => 'Unknown source <[email protected]>',
543                         -ns => $option{fill_from_ns});
544            ## From: exists, Sender: not exist
545            } elsif (!$exist->{ 'sender:'.$option{fill_sender_ns} }) {
546              my $from = $hdr->field ('from', -ns => $option{fill_from_ns});
547              if ($from->count > 1) {
548                $hdr->field ('sender', -ns => $option{fill_sender_ns})
549                    ->add ($from->item (0, -by => 'index'));
550              }
551            }
552          }
553          ## Content-MD5:
554          if (($option{fill_md5} && !$exist->{ $option{fill_md5_name} .':'. $ns_content})
555            || ($option{recalc_md5} && $exist->{ $option{fill_md5_name} .':'. $ns_content})) {
556            my $md5;
557            eval q{
558              require Digest::MD5;
559              $md5 = ($self->Message::MIME::Encoding::encode_base64 (Digest::MD5::md5 ($body0)))[0];
560              $md5 =~ tr/\x09\x0A\x0D\x20//d;
561            1} or Carp::carp $@;
562            if ($md5) {
563              my $md5f = $hdr->field ($option{fill_md5_name}, -ns => $ns_content);
564              $md5f->value ($md5);
565            }
566          }
567          my $ismime = 0;
568          for (keys %$exist) {if (/:$ns_content$/) { $ismime = 1; last }}
569          unless ($ismime) {
570            $ismime = 1 if $option{force_mime_entity}
571                        || $option{fill_md5}
572                        || $option{body_default_media_type} ne 'text'
573                        || $option{body_default_media_subtype} ne 'plain';
574        }        }
575        if ($option{fill_mimever}        if ($ismime) {
576            && !$exist{'mime-version:'.$option{fill_mimever_ns}}) {          ## Content-Type: (MIME, HTTP)
577          ## BUG: doesn't support rfc10]49, HTTP (ie. non-MIME) content-*: fields          if ($option{fill_ct} && !$exist->{'type:'.$ns_content}) {
578          $self->{header}->add ('mime-version' => '1.0',              my $ct = $hdr->field ('type', -ns => $ns_content);
579            -parse => 0, -ns => $option{fill_mimever_ns});              $ct->media_type ($option{body_default_media_type}.'/'
580                                .$option{body_default_media_subtype});
581                $ct->replace (Message::MIME::Charset::name_minimumize ($option{body_default_charset} => $body0));
582            }
583            ## MIME-Version: (MIME)
584            if ($option{fill_mimever}
585                && !$exist->{'mime-version:'.$option{fill_mimever_ns}}) {
586              ## BUG: doesn't support rfc1049, HTTP (ie. non-MIME) content-*: fields
587              $hdr->add ('mime-version' => '1.0',
588                -parse => 0, -ns => $option{fill_mimever_ns});
589            }
590          } # $ismime
591          ## User-Agent: (USEFOR, HTTP)
592          if ($option{add_ua}) {
593            $hdr->field ($option{fill_ua_name})->add_our_name (
594              -use_Config   => $option{ua_use_Config},
595              -use_Win32    => $option{ua_use_Win32},
596              -date => q$Date$,
597            );
598        }        }
599      }   # $ismime      } if $option{fill_missing_fields};
600      if ($option{format} =~ /uri-url-mailto/ && $exist{'type:$ns_content'}      
601        if ($option{format} =~ /uri-url-mailto/
602         && $self->{header}->field_exist ('type', -ns => $ns_content)
603       && $option{uri_mailto_safe_level} > 1) {       && $option{uri_mailto_safe_level} > 1) {
604        $self->{header}->field ('content-type')->media_type ('text/plain');        $self->{header}->field ('type', -ns => $ns_content)->media_type ('text/plain');
605      }      }
606      if ($option{add_ua}) {      $header = $self->{header}->stringify (
607        $self->{header}->field ($option{fill_ua_name})->add_our_name (          -format => $option{format},
608          -use_Config     => $option{ua_use_Config},          -linebreak_strict => $option{linebreak_strict},
609          -use_Win32      => $option{ua_use_Win32},          -uri_mailto_safe_level => $option{uri_mailto_safe_level},
610        );          ($filler? (-hook_stringify_fill_fields  => $filler) :()),
611      }      );
     $header = $self->{header}->stringify (-format => $option{format},  
       -linebreak_strict => $option{linebreak_strict},  
       -uri_mailto_safe_level => $option{uri_mailto_safe_level});  
612    } else {    } else {
613      $header = $self->{header};      $header = $self->{header};
614      unless ($option{linebreak_strict}) {      unless ($option{linebreak_strict}) {
# Line 609  Example: Line 666  Example:
666  sub content_type ($;%) {  sub content_type ($;%) {
667    my $self = shift;    my $self = shift;
668    my $ct = $self->{header}->field ('content-type', -new_item_unless_exist => 0);    my $ct = $self->{header}->field ('content-type', -new_item_unless_exist => 0);
669      my ($mt, $mst);
670    unless (ref $ct) {    unless (ref $ct) {
671      if ($self->{option}->{body_default_media_type} ne 'text'      $mt = $self->{option}->{body_default_media_type};
672       || $self->{option}->{body_default_media_subtype} ne 'plain') {      $mst = $self->{option}->{body_default_media_subtype};
673        if ($mt ne 'text' || $mst ne 'plain') {
674        $ct = $self->{header}->field ('content-type');        $ct = $self->{header}->field ('content-type');
675        $ct->media_type_major ($self->{option}->{body_default_media_type});        $ct->media_type_major ($mt);
676        $ct->media_type_minor ($self->{option}->{body_default_media_subtype});        $ct->media_type_minor ($mst);
677        }
678        if ($self->{option}->{guess_media_type} && $self->{body} && !ref $self->{body}) {
679          if ($self->{body} =~ /^-----BEGIN PGP SIGNED MESSAGE-----\x0D?$/m
680            && $self->{body} =~ /^-----BEGIN PGP SIGNATURE-----\x0D?$/m
681            && $self->{body} =~ /^-----END PGP SIGNATURE-----\x0D?$/m) {
682            $ct = $self->{header}->field ('content-type') unless ref $ct;
683            $mt = $ct->media_type_major ('text');
684            $mst = $ct->media_type_minor ('x-pgp-cleartext-signed');
685          } elsif ($self->{body} =~ /^-----BEGIN PGP [A-Z\x20]+-----\x0D?$/m
686            && $self->{body} =~ /^-----END PGP [A-Z\x20]+-----\x0D?$/m) {
687            $ct = $self->{header}->field ('content-type') unless ref $ct;
688            $mt = $ct->media_type_major ('application');
689            $mst = $ct->media_type_minor ('pgp');
690            $ct->parameter (format => 'text');
691          } elsif ($self->{body} =~ /^-+ start of forwarded message \(RFC 934 encapsulation\) -+\x0D?$/m) {
692            $ct = $self->{header}->field ('content-type') unless ref $ct;
693            $mt = $ct->media_type_major ('text');
694            $mst = $ct->media_type_minor ('x-message-rfc934');
695          } elsif ($self->{body} =~ /^-{70,70}\x0D?$/m
696            && $self->{body} =~ /^-{30,30}\x0D?$/m
697            && $self->{body} =~ /\x0D?\x0A-{30,30}\x0D?\x0A\x0D?\x0AEnd of.+?Digest.*?\x0D?\x0A\*+(?:\x0D?\x0A)*$/s) {
698            $ct = $self->{header}->field ('content-type') unless ref $ct;
699            $mt = $ct->media_type_major ('text');
700            $mst = $ct->media_type_minor ('x-message-rfc1153');
701          } elsif ($self->{body} =~ /^-----PRIVACY-ENHANCED MESSAGE BOUNDARY-----\x0D?$/m) {
702            $ct = $self->{header}->field ('content-type') unless ref $ct;
703            $mt = $ct->media_type_major ('text');
704            $mst = $ct->media_type_minor ('x-message-pem');
705          }
706        }
707      } else {
708        ($mt, $mst) = ($ct->media_type_major, $ct->media_type_minor);
709      }
710      if ($self->{option}->{guess_media_type}) {
711        if ($mt eq 'text' && $mst eq 'plain') {
712          my $mls = $self->{header}->field ('x-mlserver', -new_item_unless_exist => 0);
713          if (ref $mls && $mls =~ /fml/) {
714            my $s = $self->{header}->field ('subject', -new_item_unless_exist => 0);
715            if (index ($s, 'RFC934(mh-burst)') >= 0) {
716              $ct = $self->{header}->field ('content-type') unless ref $ct;
717              $mt = $ct->media_type_major ('text');
718              $mst = $ct->media_type_minor ('x-message-rfc934');
719              $ct->delete ('charset');
720            } elsif (index ($s, 'Digest (RFC1153)') >= 0) {
721              $ct = $self->{header}->field ('content-type') unless ref $ct;
722              $mt = $ct->media_type_major ('text');
723              $mst = $ct->media_type_minor ('x-message-rfc1153');
724              $ct->delete ('charset');
725            }
726          }
727      }      }
     return wantarray? ($self->{option}->{body_default_media_type},  
                        $self->{option}->{body_default_media_subtype}):  
                       $self->{option}->{body_default_media_type}.'/'  
                       .$self->{option}->{body_default_media_subtype};  
728    }    }
729    if (wantarray) {    if (wantarray) {
730      ($ct->media_type_major, $ct->media_type_minor);      ($mt, $mst);
731    } else {    } else {
732      $ct->media_type;      $ct->media_type;
733    }    }
# Line 647  sub id ($) { Line 752  sub id ($) {
752    '';    '';
753  }  }
754    
755    sub sender ($;%) {
756      my $self = shift;
757      my %params = @_;
758      my %option = %{$self->{option}};
759      $option{use_x_envelope_from} = 1;     ## X-Envelope-From:
760      $option{use_normal} = 1;      ## From:, Sender:
761      $option{use_resent} = 1;      ## Resent-From:, Resent-Sender:
762      my $hdr = $self->{header};
763      if ($option{use_x_envelope_from} && $hdr->field_exist ('x-envelope-from')) {
764        return $hdr->field ('x-envelope-from')->addr_spec;
765      } elsif ($option{use_resent} && $hdr->field_exist ('resent-sender')) {
766        ## TODO: Resent block support
767        return $hdr->field ('resent-sender')->addr_spec;
768      } elsif ($option{use_resent} && $hdr->field_exist ('resent-from')) {
769        ## TODO: Resent block support
770        return $hdr->field ('resent-from')->addr_spec;
771      } elsif ($option{use_normal} && $hdr->field_exist ('sender')) {
772        return $hdr->field ('sender')->addr_spec;
773      } elsif ($option{use_normal} && $hdr->field_exist ('from')) {
774        return $hdr->field ('from')->addr_spec;
775      }
776      undef;
777    }
778    
779    sub destination ($;%) {
780      my $self = shift;
781      my %params = @_;
782      my %option = %{$self->{option}};
783      $option{use_x_envelope_to} = 1;       ## X-Envelope-To:
784      $option{use_normal} = 1;      ## To:, Cc:, Bcc:
785      $option{use_resent} = 1;      ## Resent-To:, Resent-Cc:, Resent-Bcc:
786      for (grep {/^-/} keys %params) {$option{substr ($_, 1)} = $params{$_}}
787      my $hdr = $self->{header};
788      my @to;
789      if ($option{use_x_envelope_to} && $hdr->field_exist ('x-envelope-to')) {
790        @to = $hdr->field ('x-envelope-to')->addr_spec;
791      } elsif ($option{use_resent} && $hdr->field_exist ('resent-from')) {
792        ## TODO: Resent block support
793        @to = ($hdr->field ('resent-to')->addr_spec,
794               $hdr->field ('resent-cc')->addr_spec,
795               $hdr->field ('resent-bcc')->addr_spec);
796      } elsif ($option{use_normal}) {
797        @to = ($hdr->field ('to')->addr_spec,
798               $hdr->field ('cc')->addr_spec,
799               $hdr->field ('bcc')->addr_spec);
800      }
801      @to;
802    }
803    
804  =back  =back
805    
806  =head1 MISC. METHODS  =head1 MISC. METHODS
# Line 674  sub option ($@) { Line 828  sub option ($@) {
828    my %option = @_;    my %option = @_;
829    while (my ($name, $value) = splice (@_, 0, 2)) {    while (my ($name, $value) = splice (@_, 0, 2)) {
830      $self->{option}->{$name} = $value;      $self->{option}->{$name} = $value;
     if ($name eq 'format') {  
       $self->header->option (-format => $value);  
     }  
831    }    }
832    if ($option{-recursive}) {    if ($option{-recursive} && ($self->content_type)[0] ne 'message') {
833      $self->{header}->option (%option);      $self->{header}->option (%option);
834      $self->{body}->option (%option) if ref $self->{body};      $self->{body}->option (%option) if ref $self->{body};
835    }    }
# Line 711  sub method_available ($$) { Line 862  sub method_available ($$) {
862    0;    0;
863  }  }
864    
865    sub import ($;%) {
866      my $self = shift;
867      my %option = @_;
868      for (keys %option) {
869        $DEFAULT{$_} = $option{$_};
870      }
871      if ($option{-body_default_charset} && !$option{-body_default_charset_input}) {
872        $DEFAULT{-body_default_charset_input} = $option{-body_default_charset};
873      }
874      if ($option{-header_default_charset} && !$option{-header_default_charset_input}) {
875        $DEFAULT{-header_default_charset_input} = $option{-header_default_charset};
876      }
877    }
878    
879  =back  =back
880    
881  =head1 C<format>  =head1 C<format>
# Line 733  Internet mail message, defined by IETF R Line 898  Internet mail message, defined by IETF R
898    
899  Internet mail message, defined by IETF RFC 822  Internet mail message, defined by IETF RFC 822
900    
901    =item mail-rfc822+rfc1123
902    
903    Internet mail message, defined by IETF RFC 822, ammended by RFC 1123
904    
905  =item mail-rfc2822  =item mail-rfc2822
906    
907  Internet mail message, defined by IETF RFC 2822  Internet mail message, defined by IETF RFC 2822
# Line 813  HTTP/1.1 response message, defined by IE Line 982  HTTP/1.1 response message, defined by IE
982    
983  CGI/1.1 output (for HTTP), defined by coar-cgi-v11 (IETF Internet Draft)  CGI/1.1 output (for HTTP), defined by coar-cgi-v11 (IETF Internet Draft)
984    
 =item http-1.0-cgi-1.1  
   
 CGI/1.1 output (for HTTP/1.0), defined by coar-cgi-v11 (IETF Internet Draft)  
   
 =item http-1.1-cgi-1.1  
   
 CGI/1.1 output (for HTTP/1.1), defined by coar-cgi-v11 (IETF Internet Draft)  
   
985  =item http-cgi-1.2  =item http-cgi-1.2
986    
987  CGI/1.2 output, defined by coar-cgi-v12 (to be IETF Internet Draft)  CGI/1.2 output, defined by coar-cgi-v12 (to be IETF Internet Draft)
988    
 =item http-1.0-cgi-1.2  
   
 CGI/1.2 output (for HTTP/1.0), defined by coar-cgi-v11 (IETF Internet Draft)  
   
 =item http-1.1-cgi-1.2  
   
 CGI/1.2 output (for HTTP/1.1), defined by coar-cgi-v11 (IETF Internet Draft)  
   
989  =item http-sip-2.0  =item http-sip-2.0
990    
991  SIP/2.0 message, defined by IETF RFC 2543  SIP/2.0 message, defined by IETF RFC 2543
# Line 853  SIP/2.0 CGI (IETF Internet Draft) Line 1006  SIP/2.0 CGI (IETF Internet Draft)
1006    
1007  CPIM/1.0 (IETF Internet Draft)  CPIM/1.0 (IETF Internet Draft)
1008    
1009  =item uri-url-mailto-mail-rfc822, uri-url-mailto-mail-rfc2822  =item uri-url-mailto
1010    
1011  mailto: URL scheme  mailto: URL scheme
1012    
# Line 861  mailto: URL scheme Line 1014  mailto: URL scheme
1014    
1015  mailto: URL scheme (defined by RFC 1738)  mailto: URL scheme (defined by RFC 1738)
1016    
1017  =item uri-url-mailto-rfc2368, uri-url-mailto-rfc2822  =item uri-url-mailto-rfc2368
1018    
1019  mailto: URL scheme (defined by RFC 2368)  mailto: URL scheme (defined by RFC 2368)
1020    
1021  =item uri-url-mailto-to-mail-rfc822, uri-url-mailto-to-mail-rfc2822  =item uri-url-mailto-to
1022    
1023  C<to> part of mailto: URL scheme (for internal use only)  C<to> part of mailto: URL scheme (for internal use only)
1024    
Legend:
Removed from v.1.24  
changed lines
  Added in v.1.35
[email protected]
 ViewVC Help
Powered by ViewVC 1.1.24