/[suikacvs]/messaging/manakai/doc/example/sendmsg/send-msg.pl
Suika

Diff of /messaging/manakai/doc/example/sendmsg/send-msg.pl

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

revision 1.1 by wakaba, Fri Jul 26 06:25:30 2002 UTC revision 1.4 by wakaba, Sun Jul 28 00:11:50 2002 UTC
# Line 1  Line 1 
1    # $Header$
2    # $RCSfile$ $Source$
3  use strict;  use strict;
4  use vars qw($MYNAME $VERSION);  use vars qw($MYNAME $MYVERSION $VERSION);
5  $MYNAME = 'send.pl'; $VERSION = '2.4';  $MYNAME = $0;
6    $VERSION=do{my @r=(q$Revision$=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
7    $MYVERSION = qq{2.5.$VERSION};
8  use lib qw(/home/wakaba/temp/msg/);  use lib qw(/home/wakaba/temp/msg/);
9  use Message::Entity;  use Message::Entity;
10  use Message::Field::Date;  use Message::Field::Date;
# Line 13  $server{smtp} ||= 'suika.fam.cx'; Line 17  $server{smtp} ||= 'suika.fam.cx';
17  $server{nntp} ||= 'suika.fam.cx';  $server{nntp} ||= 'suika.fam.cx';
18  my $debug_msg_log = 0;  my $debug_msg_log = 0;
19    
 my $myhostname = 'send-msg';  
   
20  open LOG, '>> send.slog';  binmode LOG;  open LOG, '>> send.slog';  binmode LOG;
21  my $date = Message::Field::Date->new (zone => [+1, 9, 0]);  my $date = Message::Field::Date->new (zone => [+1, 9, 0]);
22  $date->unix_time (time);  $date->unix_time (time);
# Line 53  for my $file (@files) { Line 55  for my $file (@files) {
55    my $header = $msg->header;    my $header = $msg->header;
56        
57      ## Envelope From, To      ## Envelope From, To
58      my $eFrom = $header->field ('x-envelope-from')->addr_spec;      my $eFrom = $msg->sender;
59      my $resent = $header->field ('resent-from')->addr_spec;      my $resent = $header->field_exist ('resent-from');
60      if ($resent) {      my @eTo = $msg->destination;
       $eFrom ||= $resent;  
     } else {  
       $eFrom ||= $header->field ('from')->addr_spec;  
     }  
     my @eTo = $header->field ('x-envelope-to')->addr_spec;  
61      my ($send_mail,$post_news) = (0, 0);      my ($send_mail,$post_news) = (0, 0);
62      if ($resent) {      unless ($resent) {
       @eTo =($header->field ('resent-to')->addr_spec,  
              $header->field ('resent-cc')->addr_spec,  
              $header->field ('resent-bcc')->addr_spec) if $#eTo < 0;  
     } else {  
       @eTo =($header->field ('to')->addr_spec,  
              $header->field ('cc')->addr_spec,  
              $header->field ('bcc')->addr_spec) if $#eTo < 0;  
63        $post_news = 1 if $header->field_exist ('newsgroups');        $post_news = 1 if $header->field_exist ('newsgroups');
64      }      }
65      $send_mail = 1 if @eTo > 0;      $send_mail = 1 if @eTo > 0;
# Line 121  for my $file (@files) { Line 111  for my $file (@files) {
111    if ($Jcode::VERSION) {    if ($Jcode::VERSION) {
112      $ua->add ('Jcode.pm' => $Jcode::VERSION);      $ua->add ('Jcode.pm' => $Jcode::VERSION);
113    }    }
114    #my $jv=do{my @r=($jcode::rcsid=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};    if ($jcode::rcsid) {
115    $ua->add ('jcode.pl' => ['',$jcode::rcsid]);      $ua->add_rcs ($jcode::rcsid);
116    $ua->add ($MYNAME => $VERSION);    }
117      $ua->add_rcs (q$Date$, name => $MYNAME, version => $MYVERSION, -prepend => 1);
118        
119    $header->delete (qw(bcc date-received relay-version resent-bcc status x-envelope-from x-envelope-to xref));    $header->delete (qw(date-received relay-version status x-envelope-from x-envelope-to xref));
120      $header->option (field_sort => 'good-practice') unless $resent;
121        
122    my %sopt = (    my %sopt = (
123      -fill_date  => 0,   -fill_msgid     => 0,      -fill_date  => 0,   -fill_msgid     => 0,
# Line 134  for my $file (@files) { Line 126  for my $file (@files) {
126    my ($msg_mail, $msg_news);    my ($msg_mail, $msg_news);
127    if ($send_mail) {    if ($send_mail) {
128      $msg_mail =  $msg->stringify (-format => 'mail-rfc2822', %sopt);      $msg_mail =  $msg->stringify (-format => 'mail-rfc2822', %sopt);
     #$msg_mail =~ s/\x0D\x0A|\x0D|\x0A/\x0D\x0A/gs;  
129      $msg_mail =~ s/\x0D\x0A\./\x0D\x0A../gs;      $msg_mail =~ s/\x0D\x0A\./\x0D\x0A../gs;
     #$msg_mail =~ s/^(?:\x0D\x0A)+//;  
     #$msg_mail =~ s/(?:\x0D\x0A)*$/\x0D\x0A/;  
130      $msg_mail .= "\x0D\x0A.\x0D\x0A";      $msg_mail .= "\x0D\x0A.\x0D\x0A";
131    }    }
132    if ($post_news) {    if ($post_news) {
133      my %rename;      my %rename;
134      for (qw(cc complaints-to nntp-posting-date injector-info nntp-posting-host posting-version received to x-complaints-to x-trace)) {      for (qw(cc complaints-to injector-info received to x-complaints-to x-trace)) {
135          $rename{$_} = 'original-'.$_;
136        }
137        for (qw(nntp-posting-date nntp-posting-host posting-version)) {
138        $rename{$_} = 'x-'.$_;        $rename{$_} = 'x-'.$_;
139      }      }
140      $header->rename (%rename);      $header->rename (%rename);
141      $msg_news =  $msg->stringify (-format => 'news-usefor', %sopt);      $msg_news =  $msg->stringify (-format => 'news-usefor', %sopt);
     #$msg_news =~ s/\x0D\x0A|\x0D|\x0A/\x0D\x0A/gs;  
142      $msg_news =~ s/\x0D\x0A\./\x0D\x0A../gs;      $msg_news =~ s/\x0D\x0A\./\x0D\x0A../gs;
     #$msg_news =~ s/^(?:\x0D\x0A)+//;  
     #$msg_news =~ s/(?:\x0D\x0A)*$/\x0D\x0A/;  
143      $msg_news .= "\x0D\x0A.\x0D\x0A";      $msg_news .= "\x0D\x0A.\x0D\x0A";
144    }    }
145        
# Line 299  sub smsg119 {pmsg('S119: '.shift,@_)} Line 288  sub smsg119 {pmsg('S119: '.shift,@_)}
288    
289  sub Send::SMTP::Connect (;%) {  sub Send::SMTP::Connect (;%) {
290    my %o = @_;    my %o = @_;
291    my $myname = $o{myname} || 'send.pl.'.$server{smtp};    my $myname = $o{myname} || &Message::Util::get_host_fqdn || 'send.pl.'.$server{smtp};
292    pmsg('connecting to '.$server{smtp}.':25...');    pmsg('connecting to '.$server{smtp}.':25...');
293      socket (SMTP, PF_INET, SOCK_STREAM, (getprotobyname('tcp'))[2]);      socket (SMTP, PF_INET, SOCK_STREAM, (getprotobyname('tcp'))[2]);
294      my $aton = inet_aton($server{smtp});      my $aton = inet_aton($server{smtp});
# Line 338  sub Send::NNTP::Connect { Line 327  sub Send::NNTP::Connect {
327    $Send::NNTP::connected = 1;    $Send::NNTP::connected = 1;
328  }  }
329    
 sub __fw2hw ($) {  
   my $s = shift;  
   jcode::tr(\$s, "\xa3\xb0-\xa3\xb9\xa3\xc1-\xa3\xda\xa3\xe1-\xa3\xfa\xa1\xf5".  
                  "\xa1\xa4\xa1\xa5\xa1\xa7\xa1\xa8\xa1\xa9\xa1\xaa\xa1\xae".  
                  "\xa1\xb0\xa1\xb2\xa1\xbf\xa1\xc3\xa1\xca\xa1\xcb\xa1\xce".  
                  "\xa1\xcf\xa1\xd0\xa1\xd1\xa1\xdc\xa1\xf0\xa1\xf3\xa1\xf4".  
                  "\xa1\xf6\xa1\xf7\xa1\xe1\xa2\xaf\xa2\xb0\xa2\xb2\xa2\xb1".  
                  "\xa1\xe4\xa1\xe3\xA1\xC0\xA1\xA1" =>  
             '0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@=\'"~-><\\ ');  
   $s;  
 }  
   
330  END {  END {
331        Send::SMTP::Close() if $Send::SMTP::connected;        Send::SMTP::Close() if $Send::SMTP::connected;
332        Send::NNTP::Close() if $Send::NNTP::connected;        Send::NNTP::Close() if $Send::NNTP::connected;
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24