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

Contents of /www/namazu/filter/compress.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: compress.pl,v 1.15 2000/03/23 10:41:04 knok 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 compress;
26 use strict;
27 require 'util.pl';
28
29 my $zcatpath = undef;
30
31 sub mediatype() {
32 return ('application/x-compress');
33 }
34
35 sub status() {
36 $zcatpath = util::checkcmd('zcat');
37 return 'no' unless (defined $zcatpath);
38 return 'yes';
39 }
40
41 sub recursive() {
42 return 1;
43 }
44
45 sub pre_codeconv() {
46 return 0;
47 }
48
49 sub post_codeconv () {
50 return 0;
51 }
52
53 sub add_magic ($) {
54 return;
55 }
56
57 sub filter ($$$$$) {
58 my ($orig_cfile, $cont, $weighted_str, $headings, $fields)
59 = @_;
60
61 my $tmpfile = util::tmpnam('NMZ.compr');
62
63 util::vprint("Processing compress file ... (using '$zcatpath')\n");
64
65 my $fh = util::efopen("|$zcatpath > $tmpfile");
66 print $fh $$cont;
67 undef $fh;
68 $fh = util::efopen("$tmpfile");
69 my $size = util::filesize($fh);
70 if ($size > $conf::FILE_SIZE_MAX) {
71 return 'too_large_gzipped_file';
72 }
73 $$cont = util::readfile($fh);
74 undef $fh;
75 unlink $tmpfile;
76 return undef;
77 }
78
79 1;

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24