tools/sylprint.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # sylprint.pl - process a Sylpheed mail and print it using enscript or lpr
   4 #
   5 # (c) 2001 by Ricardo Mones Lastra <mones@aic.uniovi.es>
   6 # This program is released under the GNU General Public License.
   7 # See README.sylprint file for details and usage.
   8
   9 # NOTE: If you want to to change configuration edit sylprint.rc file,
  10 #       all options are further explained in that file.
  11
  12 # hardwired config
  13 $headerformat = '|%W|$%/$=';
  14 $printer = 'lp';
  15 $papersize = 'A4';
  16 $encoding = 'latin1';
  17 $pageheaderfont = 'Times-Roman@11';
  18 $mailfont = 'Courier@9/13';
  19 $separator = '_';
  20 $usenscript = 1;
  21 $translate = 1;
  22 $signature = 1;
  23 $headers = 1;
  24 $preview = 0;
  25 $remquoted = '';
  26 $wrapping = 79;
  27 # programs
  28 $_=`which enscript`; chomp; $ENS=$_;
  29 $_=`which lpr`;      chomp; $LPR=$_;
  30 $_=`which gv`;       chomp; $GPR=$_;
  31 $_=`which gless`;    chomp; $TPR=$_;
  32 $rc='sylprint.rc';
  33 # parse parameters
  34 die "required filename missing\n" unless (defined($ARGV[0]));
  35 $a = 1;
  36 # get user config
  37 if (defined($ARGV[1]) && $ARGV[1] eq '-r') { $a++; }
  38 else {
  39         @spp = split('/',$0);
  40         $spp[$#spp] = '';
  41         $spp = join('/',@spp);
  42         $rcf="$spp$rc";
  43         if (-x $rcf) { do $rcf; }
  44         $rcf="$ENV{'HOME'}/.sylpheed/$rc";
  45         if (-x $rcf) { do $rcf; }
  46 }
  47 @forens = ();
  48 while (defined($ARGV[$a])) {
  49         for ($ARGV[$a]) {
  50                 /-p/ && do {
  51                         $a++;
  52                         $printer = (defined($ARGV[$a]))? $ARGV[$a]: $printer;
  53                         last;
  54                 };
  55                 /-f/ && do {
  56                         $a++;
  57                         $mailfont = (defined($ARGV[$a]))? $ARGV[$a]: $mailfont;
  58                         $_ = $mailfont;
  59                         die "$0: invalid font\n" unless (/\w+(\@\d+(\.\d+)?(\/\d+(\.\d+)?)?)?/);
  60                         last;
  61                 };
  62                 /-s/ && do {
  63                         $a++;
  64                         $separator = (defined($ARGV[$a]))? $ARGV[$a]: '';
  65                         if ($separator) {
  66                                 $_ = $separator;
  67                                 if (/-./) { $separator = ''; $a--; }
  68                         }
  69                         last;
  70                 };
  71                 /-h/ && do { $headerformat = ''; last; };
  72                 /-t/ && do { $translate = 0; last; };
  73                 /-e/ && do { $usenscript = 0; last; };
  74                 /-v/ && do { $preview++; last; };
  75                 /-w/ && do {
  76                         $a++;
  77                         $wrapping = (defined($ARGV[$a]))? $ARGV[$a]: 0;
  78                         if ($wrapping) {
  79                                 $_ = $wrapping;
  80                                 if (/-./) { $wrapping = 0; $a--; }
  81                                 else { die "$0: invalid number\n" unless (/\d+/); }
  82                         }
  83                         last;
  84                 };
  85                 /-Q/ && do {
  86                         $remquoted = '>';
  87                         if (defined($ARGV[$a + 1])) {
  88                                 $_ = $ARGV[$a + 1];
  89                                 do { $remquoted = $_; $a++ ; } unless (/-./);
  90                         }
  91                         last;
  92                 };
  93                 /-S/ && do { $signature = 0; last; };
  94                 /-H/ && do { $headers = 0; last; };
  95                 /--/ && do { $a++; @forens = splice(@ARGV,$a); last; };
  96         };
  97         $a++;
  98 }
  99 # translations/encoding
 100 $lang = (defined($ENV{'LANG'}) && $translate)? $ENV{'LANG'}: 'en';
 101 for ($lang) {
 102         /cs.*/ && do {
 103                 @cabl=("Datum","Od","Komu","Kopie","Diskusní skupiny","Pøedmìt");
 104                 $encoding = 'latin2'; # Czech (iso-8859-2)
 105                 last;
 106         };
 107         /da.*/ && do {
 108                 @cabl=("Dato","Fra","Til","Cc","Newsgroups","Emne");
 109                 last;
 110         };
 111         /de.*/ && do {
 112                 @cabl=("Datum","Von","An","Cc","Newsgruppen","Betreff");
 113                 $headerformat = '|%W|Seite $% vom $=';
 114                 last;
 115         };
 116         /el.*/ && do {
 117                 @cabl=("Çìåñïìçíßá","Áðü", "Ðñïò","Êïéíïðïßçóç","Newsgroups","ÈÝìá");
 118                 $encoding = 'greek'; # Greek (iso-8859-7)
 119                 last;
 120         };
 121         /es.*/ && do {
 122                 @cabl=("Fecha","Desde","Para","Copia","Grupos de noticias","Asunto");
 123                 $headerformat = '|%W|Pág. $% de $=';
 124                 last;
 125         };
 126         /et.*/ && do {
 127                 @cabl=("Kuupäev","Kellelt","Kellele","Koopia","Uudistegrupid","Pealkiri");
 128                 last;
 129         };
 130         /fr.*/ && do {
 131                 @cabl=("Date","De","À","Cc","Groupe de discussion","Sujet");
 132                 $headerformat = '|%W|Page $% des $=';
 133                 last;
 134         };
 135         /hr.*/ && do {
 136                 @cabl=("Datum","Od","Za","Cc","News grupe","Tema");
 137                 $encoding = 'latin2'; # Croatian (iso-8859-2)
 138                 last;
 139         };
 140         /hu.*/ && do {
 141                 @cabl=("Dátum","Feladó","Címzett","Másolat","Üzenet-azonosító","Tárgy");
 142                 $encoding = 'latin2'; # Hungarian (iso-8859-2)
 143                 last;
 144         };
 145         /it.*/ && do {
 146                 @cabl=("Data","Da","A","Cc","Gruppo di notizie","Oggetto");
 147                 $headerformat = '|%W|Pag. $% di $=';
 148                 last;
 149         };
 150         /ja.*/ && do {
 151                 @cabl=("ÆüÉÕ","º¹½Ð¿Í","°¸Àè","Cc","¥Ë¥å¡¼¥¹¥°¥ë¡¼¥×","·ïÌ¾");
 152                 warn "$0: charset not supported by enscript: using lpr\n";
 153                 $usenscript = 0;
 154                 last;
 155         };
 156         /ko.*/ && do {
 157                 @cabl=("³¯Â¥","º¸³½ »ç¶÷","¹Þ´Â »ç¶÷","ÂüÁ¶","´º½º±×·ì","Á¦¸ñ");
 158                 warn "$0: charset not supported by enscript: using lpr\n";
 159                 $usenscript = 0;
 160                 last;
 161         };
 162         /nl.*/ && do {
 163                 @cabl=("Datum","Afzender","Aan","Cc","Nieuwsgroepen","Onderwerp");
 164                 last;
 165         };
 166         /pl.*/ && do {
 167                 @cabl=("Data","Od","Do","Kopia","Grupy news","Temat");
 168                 $encoding = 'latin2'; # Polish (iso-8859-2)
 169                 last;
 170         };
 171         /pt.*/ && do {
 172                 @cabl=("Data","De","Para","Cc","Grupos de notícias","Assunto");
 173                 last;
 174         };
 175         /ru.*/ && do {
 176                 @cabl=("äÁÔÁ","ïÔ","ëÏÍÕ","ëÏÐÉÑ","çÒÕÐÐÙ ÎÏ×ÏÓÔÅÊ","ôÅÍÁ");
 177                 $encoding = 'koi8'; # Russian (koi8-r)
 178                 last;
 179         };
 180         /sv.*/ && do {
 181                 @cabl=("Datum","Från","Till","Cc","Nyhetsgrupper","Ärende");
 182                 last;
 183         };
 184         /tr.*/ && do {
 185                 @cabl=("Tarih","Kimden","Kime","Kk","Haber gruplarý","Konu");
 186                 warn "$0: charset not supported by enscript: using lpr\n";
 187                 $usenscript = 0;
 188                 last;
 189         };
 190         /zh_CN\.GB2312/ && do {
 191                 @cabl=("ÈÕÆÚ","·¢¼þÈË£º","ÖÂ(To)£º","³ËÍ(Cc)£º","ÐÂÎÅ×é£º","±êÌâ£º");
 192                 warn "$0: charset not supported by enscript: using lpr\n";
 193                 $usenscript = 0;
 194                 last;
 195         };
 196         /zh_TW\.Big5/ && do {
 197                 @cabl=("¤é´Á","¨Ó¦Û¡G","¦¬¥ó¤H","°Æ¥»","·s»D¸s²Õ¡G","¼ÐÃD¡G");
 198                 warn "$0: charset not supported by enscript: using lpr\n";
 199                 $usenscript = 0;
 200                 last;
 201         };
 202         /.*/ && do {
 203                 @cabl=("Date","From","To","Cc","Newsgroups","Subject");
 204                 last;
 205         };
 206 }
 207 # headers as given by Sylpheed
 208 %cabs = ("Date",0,"From",1,"To",2,"Cc",3,"Newsgroups",4,"Subject",5);
 209 @cabn = ("Date","From","To","Cc","Newsgroups","Subject");
 210 @cont = ("","","","","","");
 211 $body = "";
 212 # go
 213 $tmpfn="/tmp/sylprint.$ENV{'USER'}.$$";
 214 open(TMP,">$tmpfn");
 215 open(FIN,"<$ARGV[0]");
 216 LN: while (<FIN>) {
 217         $ln = $_;
 218         foreach $n (@cabn) {
 219                 $ix = $cabs{$n};
 220                 if ($cont[$ix] eq "") {
 221                         $_ = $ln;
 222                         if (/^$n:\s+(.+)$/) {
 223                                 $cont[$ix]=$1;
 224                                 next LN;
 225                         }
 226                 }
 227         }
 228         if ($remquoted ne '' && /^\Q$remquoted\E(.+)$/) { next LN; }
 229         if (!$signature && /^--\s*$/) { last; }
 230         $body = join('',$body,$ln);
 231 }
 232 close(FIN);
 233
 234 # alignment
 235 $ml = 0;
 236 foreach $n (@cabn) {
 237         $lci = length($cabl[$cabs{$n}]);
 238         $ml = (($cont[$cabs{$n}] ne "") && ($lci > $ml))? $lci: $ml;
 239 }
 240 $ml++;
 241
 242 # print headers
 243 if ($headers) {
 244         print TMP "\n\n";
 245         foreach $n (@cabn) {
 246                 $ix = $cabs{$n};
 247                 if ($cont[$ix] ne "") {
 248                         print TMP "$cabl[$ix]", " " x ($ml - length($cabl[$ix])), ": ";
 249                         if ($wrapping) {
 250                                 my $kk = 1; $wl = $wrapping;
 251                                 $l = $cont[$ix];
 252                                 while (length($l) > ($wl - $ml)) {
 253                                         $ll = substr($l,0,$wl);
 254                                         $jx = $wl - 1;
 255                                         while ((substr($ll,$jx,1) ne ' ') && $jx) { $jx--; }
 256                                         $ll = substr($l,0,($jx)? $jx: $wl,'');
 257                                         if ($kk) { print TMP $ll, "\n"; $kk--; }
 258                                         else { print TMP " ", " " x $ml, $ll, "\n"; }
 259                                 }
 260                                 if ($kk) { print TMP $l, "\n"; }
 261                                 else { print TMP " ", " " x $ml, $l, "\n"; }
 262                         }
 263                         else {
 264                                 print TMP $cont[$ix], "\n";
 265                         }
 266                 }
 267         }
 268         if ($separator) {
 269                 print TMP $separator x (($wrapping)? $wrapping: 79), "\n";
 270         };
 271 }
 272
 273 # mail body
 274 if ($wrapping) {
 275         $wl = $wrapping;
 276         @bodyl = split(/\n/,$body);
 277         foreach $l (@bodyl) {
 278                 while (length($l) > $wl) {
 279                         $ll = substr($l,0,$wl);
 280                         $ix = $wl - 1;
 281                         while ((substr($ll,$ix,1) ne ' ') && $ix) { $ix--; }
 282                         $ll = substr($l,0,($ix)? $ix: $wl,'');
 283                         print TMP $ll,"\n";
 284                 }
 285                 print TMP $l,"\n";
 286         }
 287 }
 288 else {
 289         print TMP "\n$body\n";
 290 }
 291 close(TMP);
 292
 293 # let enscript do its job
 294 if (-x $ENS and $usenscript) {
 295         @ecmd = ($ENS,'','','-b',$headerformat,'-M',$papersize,'-X',$encoding,
 296                 '-i','1c','-h','-f',$mailfont,'-F',$pageheaderfont,@forens,
 297                 $tmpfn);
 298         if ($preview) {
 299                 $ecmd[1] = '-p'; $ecmd[2] = "$tmpfn.ps";
 300                 system(@ecmd);
 301                 @vcmd = (split(' ',$GPR),"$tmpfn.ps");
 302                 system(@vcmd);
 303                 unlink("$tmpfn.ps");
 304         }
 305         if ($preview < 2) {
 306                 $ecmd[1] = '-P'; $ecmd[2] = $printer;
 307                 system(@ecmd);
 308         }
 309 }
 310 else { # no enscript, try lpr
 311         if ($usenscript) { warn "$ENS not found, using lpr\n"; }
 312         die "$LPR not found\n" unless (-x $LPR);
 313         if ($preview) {
 314                 @vcmd = (split(' ',$TPR),$tmpfn);
 315                 system(@vcmd);
 316         }
 317         if ($preview < 2) {
 318                 @lprcmd = ($LPR,'-T','Sylpheed Mail',
 319                         ($headerformat eq '')? '-l': '-p','-P',$printer,@forens,                        $tmpfn);
 320                 die "trying lpr: $! \n" unless (system(@lprcmd) != -1);
 321         }
 322 }
 323
 324 # remove tmp stuff
 325 unlink($tmpfn);