/[suikacvs]/messaging/bunshin/Bunshin.pm
Suika

Diff of /messaging/bunshin/Bunshin.pm

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

revision 1.1 by wakaba, Sun Jun 16 02:50:54 2002 UTC revision 1.3 by wakaba, Thu Jun 20 11:36:32 2002 UTC
# Line 1  Line 1 
1    
2  =head1 NAME  =head1 NAME
3    
4  Bunshin  Bunshin --- A shimbun implemrntion written in Perl
5    
6  =cut  =cut
7    
# Line 11  use vars qw($DEBUG $MYNAME $VERSION); Line 11  use vars qw($DEBUG $MYNAME $VERSION);
11  $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};  $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
12  $MYNAME = 'Bunshin';  $MYNAME = 'Bunshin';
13  $DEBUG = 0;  $DEBUG = 0;
 use Time::Local;  
14  use FileHandle;  use FileHandle;
15  require Message::Entity;  require Message::Entity;
16  require Message::Util;  require Message::Util;
# Line 89  sub set_source ($%) { Line 88  sub set_source ($%) {
88      my $c = $self->{hook_code_conversion} || \&_code_conversion;      my $c = $self->{hook_code_conversion} || \&_code_conversion;
89      local $/ = undef;      local $/ = undef;
90      $self->{source} = &$c ($self, $f->getline, \%option);      $self->{source} = &$c ($self, $f->getline, \%option);
     close SRC;  
91    } else {    } else {
92      Carp::croak "set_source: $_[0]: Unsupported data source type";      Carp::croak "set_source: $_[0]: Unsupported data source type";
93    }    }
# Line 142  sub _make_a_msg ($@) { Line 140  sub _make_a_msg ($@) {
140    ;    ;
141    my $hdr = $msg->header;    my $hdr = $msg->header;
142    ## Originator and date    ## Originator and date
143      my $from = $hdr->field ('from')->add ($p{from_mail});      my $from = $hdr->field ('from')->add ($p{from_mail} || 'foo@bar.invalid');
144      $from->display_name ($p{from_name}) if length $p{from_name};      $from->display_name ($p{from_name}) if length $p{from_name};
145      my $date = $hdr->field ('date');      my $date = $hdr->field ('date');
146      $p{date_year} ||= (gmtime)[5];      $p{date_year} ||= (gmtime)[5];
147      $date->set_datetime (@p{qw/date_year date_month      $date->set_datetime (@p{qw/date_year date_month
148        date_day date_hour date_minute date_second/},        date_day date_hour date_minute date_second/},
149        zone => $p{date_zone});        zone => $p{date_zone});
150      $hdr->add ('x-uri' => $p{from_uri}) if $p{from_uri};      $hdr->add (x_uri => $p{from_uri}) if $p{from_uri};
151      if ($p{from_face}) {      if ($p{from_face}) {
152        $msg->header->field ('x-face')->value ($p{from_face});        $msg->header->field ('x-face')->value ($p{from_face});
153      } elsif ($p{faces}->{$p{from_mail}}) {      } elsif ($p{faces}->{$p{from_mail}}) {
# Line 160  sub _make_a_msg ($@) { Line 158  sub _make_a_msg ($@) {
158    ## Message attribute    ## Message attribute
159      if (length $p{msg_id}) {      if (length $p{msg_id}) {
160        $hdr->add ('message-id' => $p{msg_id});        $hdr->add ('message-id' => $p{msg_id});
161      } else {      } elsif ($p{msg_id_from} || $p{msg_id_right} || $p{list_id}) {
       my $id_right = $p{msg_id_right} || $p{list_id};  
162        my $c = $p{msg_count};        my $c = $p{msg_count};
163        $c = '.d'.(0+$date) unless defined $p{msg_count};        $c = '.d'.(0+$date) unless defined $p{msg_count};
164        my $mid = sprintf '<msg%s.BS%%list@%s>', $c, $id_right;        my $mid;
165        $mid = sprintf '<msg%s.BS%%%s>', $c, $p{msg_id_from} if $p{msg_id_from};        if ($p{msg_id_from}) {
166            $mid = sprintf '<msg%s.BS%%%s%%%s>', $c, $p{list_id}, $p{msg_id_from};
167          } elsif ($p{msg_id_right}) {
168            $mid = sprintf '<msg%s.BS%%%s%%list@%s>', $c, $p{list_id}, $p{msg_id_right};
169          } else { #if ($p{list_id}) {
170            $mid = sprintf '<msg%s.BS%%list@%s>', $c, $p{list_id};
171          }
172        $hdr->add (($DEBUG?'x-':'').'message-id' => $mid);        $hdr->add (($DEBUG?'x-':'').'message-id' => $mid);
173      }      }
174      $hdr->add (subject => $p{subject}) if length $p{subject};      if (length $p{subject}) {
175          $hdr->add (subject => $p{subject});
176        } elsif (length $p{DEFAULT_subject}) {
177          $hdr->add (subject => $p{DEFAULT_subject});
178        }
179      my $a;      my $a;
180      for (grep {/^misc_/} keys %p) {      for (grep {/^misc_/} keys %p) {
181        $a = $hdr->field ('content-x-properties') unless ref $a;        $a = $hdr->field ('content-x-properties') unless ref $a;
# Line 176  sub _make_a_msg ($@) { Line 183  sub _make_a_msg ($@) {
183        $name =~ tr/_/-/;        $name =~ tr/_/-/;
184        if ($p{base_uri} && /uri/ && length $p{$_}) {        if ($p{base_uri} && /uri/ && length $p{$_}) {
185          require URI::WithBase;          require URI::WithBase;
186          $a->add ($name => URI::WithBase->new ($_, $p{base_uri})->abs);          $a->add ($name => URI::WithBase->new ($p{$_}, $p{base_uri})->abs);
187        } else {        } else {
188          $a->add ($name => $p{$_}) if length $p{$_};          $a->add ($name => $p{$_}) if length $p{$_};
189        }        }
# Line 190  sub _make_a_msg ($@) { Line 197  sub _make_a_msg ($@) {
197        $lid->value ($p{list_id});        $lid->value ($p{list_id});
198        $lid->display_name ($p{list_name}) if length $p{list_name};        $lid->display_name ($p{list_name}) if length $p{list_name};
199      }      }
200      $hdr->add ('x-mail-count' => $p{msg_count}) if defined $p{msg_count};      $hdr->add (x_mail_count => $p{msg_count}) if defined $p{msg_count};
201      $hdr->add ('x-ml-info' => $p{list_info}) if defined $p{list_info};      $hdr->add (x_ml_info => $p{list_info}) if defined $p{list_info};
202      if ($p{base_uri}) {      if ($p{base_uri}) {
203        my $uri = $hdr->add (x_uri => '');        my $uri = $hdr->add (x_uri => '');
204        $uri->value ($p{base_uri});        $uri->value ($p{base_uri});
# Line 203  sub _make_a_msg ($@) { Line 210  sub _make_a_msg ($@) {
210          date_time       => $date->unix_time,          date_time       => $date->unix_time,
211          zone    => $date->zone,          zone    => $date->zone,
212          fmt2str => $self->{fmt2str},          fmt2str => $self->{fmt2str},
213        });        }, \%p);
214        $hdr->add ('x-uri')->value ($urn);        $hdr->add ('x-uri')->value ($urn);
215      }      }
216    ## Additional information    ## Additional information
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24