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

Contents of /www/namazu/filter/powerpoint.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: powerpoint.pl,v 1.6 2000/12/26 04:59:01 knok Exp $
4 # Copyright (C) 2000 Ken-ichi Hirose,
5 # 2000 Namazu Project All rights reserved.
6 # This is free software with ABSOLUTELY NO WARRANTY.
7 #
8 # This program is free software; you can redistribute it and/or modify
9 # it under the terms of the GNU General Public License as published by
10 # the Free Software Foundation; either versions 2, or (at your option)
11 # any later version.
12 #
13 # This program is distributed in the hope that it will be useful
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 # GNU General Public License for more details.
17 #
18 # You should have received a copy of the GNU General Public License
19 # along with this program; if not, write to the Free Software
20 # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
21 # 02111-1307, USA
22 #
23 # This file must be encoded in EUC-JP encoding
24 #
25
26 package powerpoint;
27 use strict;
28 use File::Copy;
29 require 'util.pl';
30 require 'gfilter.pl';
31 require 'html.pl';
32
33 my $pptconvpath = undef;
34 my $utfconvpath = undef;
35
36 sub mediatype() {
37 return ('application/powerpoint');
38 }
39
40 sub status() {
41 $pptconvpath = util::checkcmd('pptHtml');
42 # return 'no' unless defined $pptconvpath
43 if (defined $pptconvpath) {
44 if (!util::islang("ja")) {
45 return 'yes';
46 } else {
47 $utfconvpath = util::checkcmd('lv');
48 if (defined $utfconvpath) {
49 return 'yes';
50 } else {
51 return 'no';
52 }
53 }
54 } else {
55 $pptconvpath = util::checkcmd('doccat');
56 return 'yes' if defined $pptconvpath;
57 return 'no';
58 }
59 }
60
61 sub recursive() {
62 return 0;
63 }
64
65 sub pre_codeconv() {
66 return 0;
67 }
68
69 sub post_codeconv () {
70 return 0;
71 }
72
73 sub add_magic ($) {
74 my ($magic) = @_;
75
76 $magic->addFileExts('\\.ppt$', 'application/powerpoint');
77 return;
78 }
79
80 sub filter ($$$$$) {
81 my ($orig_cfile, $cont, $weighted_str, $headings, $fields)
82 = @_;
83 my $err = undef;
84
85 if (util::checkcmd('pptHtml')) {
86 $err = filter_ppt($orig_cfile, $cont, $weighted_str, $headings, $fields);
87 } else {
88 $err = filter_doccat($orig_cfile, $cont, $weighted_str, $headings, $fields);
89 }
90 return $err;
91 }
92
93 sub filter_ppt ($$$$$) {
94 my ($orig_cfile, $cont, $weighted_str, $headings, $fields)
95 = @_;
96 my $cfile = defined $orig_cfile ? $$orig_cfile : '';
97
98 my $tmpfile = util::tmpnam('NMZ.powerpoint');
99 my $tmpfile2 = util::tmpnam('NMZ.powerpoint2');
100
101
102 util::vprint("Processing ms-powerpoint file ... (using '$pptconvpath')\n");
103
104 {
105 my $fh = util::efopen("> $tmpfile");
106 print $fh $$cont;
107 }
108
109 #
110
111 # handle a Japanese PowerPoint ocument correctly.
112 system("$pptconvpath $tmpfile > $tmpfile2");
113
114 {
115 my $fh = util::efopen("< $tmpfile2");
116 $$cont = util::readfile($fh);
117 }
118
119 # Code conversion for Japanese document.
120 if (util::islang("ja")) {
121 my $encoding = "u8"; # UTF-8
122 # Pattern for pptHtml
123 if ($$cont =~ m!^<FONT SIZE=-1><I>Last Updated&nbsp;using Excel 5.0 or 95</I></FONT><br>$!m)
124 {
125 $encoding = "s"; # Shift_JIS
126 }
127 {
128 my $fh = util::efopen("> $tmpfile");
129 print $fh $$cont;
130 }
131 system("$utfconvpath -I$encoding -Oej $tmpfile > $tmpfile2");
132 {
133 my $fh = util::efopen("< $tmpfile2");
134 $$cont = util::readfile($fh);
135 }
136 }
137
138 # Extract the author and exclude pptHtml's footer at once.
139 $$cont =~ s!^<FONT SIZE=-1><I>Spreadsheet's Author:&nbsp;(.*?)</I></FONT><br>.*!!ms; # '
140 $fields->{'author'} = $1 if defined $1;
141
142 unlink($tmpfile);
143 unlink($tmpfile2);
144
145 # Title shoud be removed.
146 $$cont =~ s!<TITLE>.+</TITLE>!!;
147
148 html::html_filter($cont, $weighted_str, $fields, $headings);
149
150 gfilter::line_adjust_filter($cont);
151 gfilter::line_adjust_filter($weighted_str);
152 gfilter::white_space_adjust_filter($cont);
153
154 $fields->{'title'} = gfilter::filename_to_title($cfile, $weighted_str);
155 gfilter::show_filter_debug_info($cont, $weighted_str,
156 $fields, $headings);
157 return undef;
158 }
159
160 sub filter_doccat ($$$$$) {
161 my ($orig_cfile, $cont, $weighted_str, $headings, $fields)
162 = @_;
163 my $cfile = defined $orig_cfile ? $$orig_cfile : '';
164
165 my $tmpfile = util::tmpnam('NMZ.powerpoint');
166 my $tmpfile2 = util::tmpnam('NMZ.powerpoint2');
167 copy("$cfile", "$tmpfile2");
168
169 system("$pptconvpath -o e $tmpfile2 > $tmpfile");
170
171 {
172 my $fh = util::efopen("< $tmpfile");
173 $$cont = util::readfile($fh);
174 }
175
176 unlink($tmpfile);
177 unlink($tmpfile2);
178
179 gfilter::line_adjust_filter($cont);
180 gfilter::line_adjust_filter($weighted_str);
181 gfilter::white_space_adjust_filter($cont);
182 $fields->{'title'} = gfilter::filename_to_title($cfile, $weighted_str)
183 unless $fields->{'title'};
184 gfilter::show_filter_debug_info($cont, $weighted_str,
185 $fields, $headings);
186 return undef;
187 }
188
189 1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24