fix problem with quoted strings in filter_conv.pl
[claws.git] / 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);