[BACK]Return to mail2lj.pl CVS log [TXT] [DIR] Up to [Local Repository] / mail2lj

Diff for /mail2lj/mail2lj.pl between versions 1.6 and 1.7

version 1.6, 2007/08/14 06:13:58 version 1.7, 2007/08/14 20:59:15
Line 77  my $host = $ENV{MAIL2LJ_DOMAIN} || "ledo Line 77  my $host = $ENV{MAIL2LJ_DOMAIN} || "ledo
 # my    $home = $ENV{HOME} || "/home/mail2lj" ;                 # Changed by LG  # my    $home = $ENV{HOME} || "/home/mail2lj" ;                 # Changed by LG
 my      $home = $ENV{HOME} || "/tmp/mail2lj" ;  my      $home = $ENV{HOME} || "/tmp/mail2lj" ;
   
   # Changed by LG - added because sometimes procmail doesn't set $USER.
   my      $SysUser = $ENV{USER} || $ENV{LOGNAME} || getpwuid($>) || $> ;
   
 # Changed by LG.  Specifies the default incoming and outgoing charset for  # Changed by LG.  Specifies the default incoming and outgoing charset for
 # all e-mails (i.e, the posts CONTENT and the script replies).    # all e-mails (i.e, the posts CONTENT and the script replies).  
 # For incoming mails, the MIME header is analyzed and actual MIME charset  # For incoming mails, the MIME header is analyzed and actual MIME charset
Line 228  my $alias = shift @ARGV || "none" ; Line 231  my $alias = shift @ARGV || "none" ;
 my      $mp = new MIME::Parser() or die "new MIME::Parser(): $!\n" ;  my      $mp = new MIME::Parser() or die "new MIME::Parser(): $!\n" ;
   
   
 # Changed by LG - changed directory.  # Changed by LG - changed directory to be user and process-specific.
 # $mp->output_dir("$home/mimetmp") ;  # $mp->output_dir("$home/mimetmp") ;
 $mp->output_dir("/tmp/mimetmp-".$ENV{USER}) ;  $mp->output_dir("/tmp/mimetmp-" . $SysUser . "-$$") ;
 mkdir $mp->output_dir if not -d $mp->output_dir ;       # Create it if missing  mkdir $mp->output_dir if not -d $mp->output_dir ;       # Create it if missing
   
 # Get the whole mail.  # Get the whole mail.
   # Changed by LG - added removal of output directory.
 my      $me = $mp->parse(\*STDIN) ;  my      $me = $mp->parse(\*STDIN) ;
 END     { $me && $me->purge() } ;  END     { $me and $me->purge() ;
             rmdir $mp->output_dir if -d $mp->output_dir 
                   or print STDERR "Error removing $mp->output_dir: $!\n" ;
           } ;
   
   
 # Changed by LG -  different log file name.  # Changed by LG -  different log file name.
 # open(STDERR, ">>$home/generic.log") or die "open(`log'): $!\n" ;  # open(STDERR, ">>$home/generic.log") or die "open(`log'): $!\n" ;
Line 578  sub hdr2utf8 { Line 586  sub hdr2utf8 {
         return $r ;          return $r ;
 }  }
   
   
   # Changed by LG - added this subroutine for a shortcut call to to_utf8().
   # All it does is conversion of a string to utf8.
   sub     str2utf8 {
           my      ($s, $e) = @_;
           my      $r = "" ;
   
           $r .= to_utf8({ -string => $s, -charset => $e }) ;
           return $r ;
   }
   
 sub     post_me2req {  sub     post_me2req {
         my      ($me, $e, $hints) = @_ ;          my      ($me, $e, $hints) = @_ ;
         my      $mebh = $me->bodyhandle() or die "post_message(): no body?\n" ;          my      $mebh = $me->bodyhandle() or die "post_message(): no body?\n" ;
Line 585  sub post_me2req { Line 604  sub post_me2req {
         my      $charset = $mehh->mime_attr("content-type.charset") || $e ;          my      $charset = $mehh->mime_attr("content-type.charset") || $e ;
         my      $subject = hdr2utf8($me->get('Subject') || "", $charset) ;          my      $subject = hdr2utf8($me->get('Subject') || "", $charset) ;
         chomp $subject ;                                        # Changed by LG          chomp $subject ;                                        # Changed by LG
           # Changed by LG.
         # Changed by LG          my $from = hdr2utf8($me->get('From') || "", $charset) ;
         my      $from = hdr2utf8($me->get('From') || "", $charset) ;  
         chomp $from ;          chomp $from ;
   
         my      $hr = href2utf8(post_body2href($mebh->open("r")), $charset) ;          my      $hr = href2utf8(post_body2href($mebh->open("r")), $charset) ;
Line 608  sub post_me2req { Line 626  sub post_me2req {
         # Changed by LG - removed prefixing.          # Changed by LG - removed prefixing.
         # $hr->{subject} = "[mail2lj] " . $hr->{subject} ;          # $hr->{subject} = "[mail2lj] " . $hr->{subject} ;
   
         # Changed by LG - added options to add the 'From' field to the          # Changed by LG - added options to add the plain or HTML-ized 'From'
         # posted message.          # field to the posted message.
         #           # 
         # NOTE: $from is already in UTF8.  Strictly speaking, everything          # NOTE: $from is already in UTF8, but the "From:" and HTML tags are
         #       that we add to it MUST ALSO BE IN UTF8 (i.e. you need to run          #       not.  Strictly speaking, everything that goes to $hr->{event}
         #       a to_utf8() function on it).  But since all I'm adding is in          #       MUST ALSO BE IN UTF8.  A cheating shortcut is possible:
         #       ISO-8859-1 lower ASCII characters (which are guaranteed to          #       since all lower ASCII characters are guaranteed to have
         #       have the same values in UTF8 as in plain ISO-8859-1), I'm          #       the same values in UTF8 as in plain ISO-8859-1, you could
         #       cheating here and taking a shortcut. If you want to add          #       possibly stick ASCII strings to $from without risk.  But in
         #       something non-ASCII, you MUST convert it to UTF8 first!          #       order to add something non-ASCII, you absolutely MUST convert
         #       Be forewarned!          #       it to UTF8 first!  To avoid the risk of forgetting this, the
         if ( $opt_addfrom ) {          #       following substitutions are done in a _proper_ (albeit 
            $hr->{event} = "From: $from" . "\n\n" . $hr->{event} ;          #       somewhat awkward) way.
         } elsif ( $opt_addfromh ) {          if ( $opt_addfrom || $opt_addfromh ) {
            my $html_from = "<nobr><i><b>From:</b> $from</i></nobr>" ;  
            $html_from =~ s/\@/[_\@_]/g ;             # Assemble the added From string in UTF8.
            $hr->{event} = $html_from . "\n\n" . $hr->{event} ;             my $added_from ;
         }             if ( $opt_addfrom ) {
                 $added_from = str2utf8("From: ", "ISO-8859-1") 
                               . $from . str2utf8("\n\n", "ISO-8859-1") ;
              } elsif ( $opt_addfromh ) {
                 $added_from = str2utf8("<nobr><i><b>From:</b> ", "ISO-8859-1" )
                               . $from
                               . str2utf8("</i></nobr>\n\n", "ISO-8859-1") ;
              }
   
              # Obfuscate the address.
              my $olddog = str2utf8("\@", "ISO-8859-1") ;          # @ in utf8
              my $newdog = str2utf8("[_\@_]", "ISO-8859-1") ;      # [_@_] in utf8
              $added_from =~ s/$olddog/$newdog/g ;                 # Obfuscate
              $hr->{event} = $added_from . $hr->{event} ;          # And append
           } 
   
         # Changed by LG - added an option to preserve (html-ize) multiple          # Changed by LG - added an option to preserve (html-ize) multiple
         # spaces and tabs (convert '\t' to eight '&nbsp;' and convert          # spaces and tabs (convert '\t' to eight '&nbsp;' and convert
         # multiple continuous spaces into sequence of ' &nbsp;').          # multiple continuous spaces into sequence of ' &nbsp;').
         # Lines with tabs are additionally wrapped in <nobr>...</nobr> tags.          # Lines with tabs are additionally wrapped in <nobr>...</nobr> tags.
           #
           # NOTE: These tags should be in UTF8.  But since HTML tags themselves
           #       are *certainly* in lower ASCII, we can safely stick them on
           #       top of the existing UTF8 post.  But if you dare to add 
           #       anything more than ASCII-markup, you'd better str2utf8() it
           #       first!  See note in the $opt_addfrom/$opt_addfromh processing above.
         if ( $opt_keepspaces ) {          if ( $opt_keepspaces ) {
            $hr->{event} =~ s/^(.*\t.*)$/<nobr>$1<\/nobr>/gm ;             $hr->{event} =~ s/^(.*\t.*)$/<nobr>$1<\/nobr>/gm ;
            $hr->{event} =~ s/\t/\&nbsp;\&nbsp;\&nbsp;\&nbsp;\&nbsp;\&nbsp;\&nbsp;\&nbsp;/g ;             $hr->{event} =~ s/\t/\&nbsp;\&nbsp;\&nbsp;\&nbsp;\&nbsp;\&nbsp;\&nbsp;\&nbsp;/g ;
Line 641  sub post_me2req { Line 679  sub post_me2req {
         # Change by BV - added the option to put lj-cut after '--cut XX' lines          # Change by BV - added the option to put lj-cut after '--cut XX' lines
         #          #
         # Tweaked by LG - only adding lj-cut if more than $ljcut_delta lines          # Tweaked by LG - only adding lj-cut if more than $ljcut_delta lines
         # is left in the posting.          # is left in the posting.  Also added $opt_ljcut_text.
         #          #
         if ($opt_ljcut>0) {          if ($opt_ljcut>0) {
             my $nlines = scalar( my @junk=split( /\n/, $hr->{event}, -1) ) - 1;              my $nlines = scalar( my @junk=split( /\n/, $hr->{event}, -1) ) - 1;
Removed from v.1.6  
changed lines
  Added in v.1.7

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>