/[suikacvs]/www/namazu/filter/postscript.pl
Suika

Contents of /www/namazu/filter/postscript.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (download) (vendor branch)
Fri Nov 30 07:56:45 2001 UTC (22 years, 5 months ago) by wakaba
Branch: MAIN, wakaba
CVS Tags: initial, HEAD
Changes since 1.1: +0 -0 lines
File MIME type: text/plain

1 #
2 # -*- Perl -*-
3 # $Id: postscript.pl,v 1.4.4.1 2001/08/20 13:32:17 baba Exp $
4 # Copyright (C) 2000 Namazu Project All rights reserved ,
5 # This is free software with ABSOLUTELY NO WARRANTY.
6 #
7 # This program is free software; you can redistribute it and/or modify
8 # it under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either versions 2, or (at your option)
10 # any later version.
11 #
12 # This program is distributed in the hope that it will be useful
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
16 #
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
20 # 02111-1307, USA
21 #
22 # This file must be encoded in EUC-JP encoding
23 #
24
25 package postscript;
26 use strict;
27 require 'util.pl';
28
29 my $postscriptpath = undef;
30
31 sub mediatype() {
32 return ('application/postscript');
33 }
34
35 sub status() {
36 if (util::islang("ja")) {
37 $postscriptpath = util::checkcmd('ps2text');
38 } else {
39 $postscriptpath = util::checkcmd('ps2ascii');
40 }
41 return 'no' unless (defined $postscriptpath);
42 return 'yes';
43 }
44
45 sub recursive() {
46 return 0;
47 }
48
49 sub pre_codeconv() {
50 return 0;
51 }
52
53 sub post_codeconv () {
54 return 0;
55 }
56
57 sub add_magic ($) {
58 return;
59 }
60
61 sub filter ($$$$$) {
62 my ($orig_cfile, $cont, $weighted_str, $headings, $fields)
63 = @_;
64
65 my $tmpfile = util::tmpnam('NMZ.postscript');
66 my $tmpfile2 = util::tmpnam('NMZ.postscript2');
67
68 util::vprint("Processing postscript file ... (using '$postscriptpath')\n");
69
70 my $fh = util::efopen("> $tmpfile");
71 print $fh $$cont;
72 undef $fh;
73
74 my $landscape = 0;
75 $fh = util::efopen("$tmpfile");
76 while (<$fh>) {
77 last if (/^%%EndComments$/);
78 $landscape = 1 if (/^%%Orientation: Landscape$/i);
79 }
80 undef $fh;
81
82 if (util::islang("ja")) {
83 if ($landscape) {
84 system("$postscriptpath -q -l $tmpfile > $tmpfile2");
85 } else {
86 system("$postscriptpath -q $tmpfile > $tmpfile2");
87 }
88 } else {
89 system("$postscriptpath -q $tmpfile > $tmpfile2");
90 }
91 unless ($? == 0) {
92 unlink($tmpfile);
93 unlink($tmpfile2);
94 return "Unable to convert postscript file ($postscriptpath error occurred)";
95 }
96
97 $fh = util::efopen("$tmpfile2");
98 my $size = util::filesize($fh);
99 if ($size == 0) {
100 undef $fh;
101 unlink($tmpfile);
102 unlink($tmpfile2);
103 return "Unable to convert postscript file ($postscriptpath error occurred)";
104 }
105 if ($size > $conf::FILE_SIZE_MAX) {
106 undef $fh;
107 unlink($tmpfile);
108 unlink($tmpfile2);
109 return 'too_large_postscript_file';
110 }
111 $$cont = util::readfile($fh);
112 undef $fh;
113 unlink($tmpfile);
114 unlink($tmpfile2);
115 return undef;
116 }
117
118 1;
119
120

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24