version 1.4, 2007/08/14 04:19:50
|
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 207 if ( exists $Opt{'comments'} ) {
|
Line 210 if ( exists $Opt{'comments'} ) {
|
# with other parameters. |
# with other parameters. |
$Opt{'prop_taglist'} = join( ", ", @opt_taglist ) if ( @opt_taglist ) ; |
$Opt{'prop_taglist'} = join( ", ", @opt_taglist ) if ( @opt_taglist ) ; |
|
|
# Convert all command line options to unicode. |
# Convert $opt_ljcut_text to UTF8. |
|
if ( defined $opt_ljcut_text ) { |
|
$opt_ljcut_text = |
|
to_utf8({ -string => $opt_ljcut_text, -charset => $SystemCharset }) ; |
|
} |
|
|
|
# Convert all %Opt command line options to unicode. |
# Function href2utf8() uses a reference to input hash, so %Opt is |
# Function href2utf8() uses a reference to input hash, so %Opt is |
# being modified "in-place". |
# being modified "in-place". |
href2utf8( \%Opt, $SystemCharset) ; |
href2utf8( \%Opt, $SystemCharset) ; |
Line 222 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 572 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 579 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 602 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. |
if ( $opt_addfrom ) { |
# |
$hr->{event} = "From: $from" . "\n\n" . $hr->{event} ; |
# NOTE: $from is already in UTF8, but the "From:" and HTML tags are |
} elsif ( $opt_addfromh ) { |
# not. Strictly speaking, everything that goes to $hr->{event} |
my $html_from = "<nobr><i><b>From:</b> $from</i></nobr>" ; |
# MUST ALSO BE IN UTF8. A cheating shortcut is possible: |
$html_from =~ s/\@/[_\@_]/g ; |
# since all lower ASCII characters are guaranteed to have |
$hr->{event} = $html_from . "\n\n" . $hr->{event} ; |
# the same values in UTF8 as in plain ISO-8859-1, you could |
} |
# possibly stick ASCII strings to $from without risk. But in |
|
# order to add something non-ASCII, you absolutely MUST convert |
|
# it to UTF8 first! To avoid the risk of forgetting this, the |
|
# following substitutions are done in a _proper_ (albeit |
|
# somewhat awkward) way. |
|
if ( $opt_addfrom || $opt_addfromh ) { |
|
|
|
# Assemble the added From string in UTF8. |
|
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 ' ' and convert |
# spaces and tabs (convert '\t' to eight ' ' and convert |
# multiple continuous spaces into sequence of ' '). |
# multiple continuous spaces into sequence of ' '). |
# 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/\ \ \ \ \ \ \ \ /g ; |
$hr->{event} =~ s/\t/\ \ \ \ \ \ \ \ /g ; |
Line 626 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; |