source: trunk/gsdl/perllib/plugins/ZIPPlug.pm@ 2795

Last change on this file since 2795 was 2795, checked in by sjboddie, 23 years ago

Got ZIPPlug working under under windows

  • Property svn:keywords set to Author Date Id Revision
File size: 3.8 KB
Line 
1###########################################################################
2#
3# ZIPPlug.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 1999 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26# plugin which handles compressed and/or archived input formats
27#
28# currently handled formats and file extensions are:
29#
30# gzip (.gz, .z, .tgz, .taz)
31# bzip (.bz)
32# bzip2 (.bz2)
33# zip (.zip .jar)
34# tar (.tar)
35#
36# this plugin relies on the following utilities being present
37# (if trying to process the corresponding formats)
38#
39# gunzip (for gzip)
40# bunzip (for bzip)
41# bunzip2
42# unzip (for zip)
43# tar (for tar)
44
45package ZIPPlug;
46
47use BasPlug;
48use plugin;
49use util;
50use Cwd;
51
52
53BEGIN {
54 @ISA = ('BasPlug');
55}
56
57sub new {
58 my ($class) = @_;
59 my $self = new BasPlug ("ZIPPlug", @_);
60
61 return bless $self, $class;
62}
63
64# this is a recursive plugin
65sub is_recursive {
66 my $self = shift (@_);
67
68 return 1;
69}
70
71# return number of files processed, undef if can't process
72# Note that $base_dir might be "" and that $file might
73# include directories
74sub read {
75 my $self = shift (@_);
76 my ($pluginfo, $base_dir, $file, $metadata, $processor, $maxdocs) = @_;
77 my $outhandle = $self->{'outhandle'};
78
79 if ($file =~ /\.(gz|tgz|z|taz|bz|bz2|zip|jar|tar)$/i) {
80
81 my $filename = $file;
82 $filename = &util::filename_cat ($base_dir, $file) if $base_dir =~ /\w/;
83 if (!-e $filename) {
84 print $outhandle "ZIPPLug: WARNING: $filename does not exist\n";
85 return undef;
86 }
87
88 my ($file_only) = $file =~ /([^\\\/]*)$/;
89 my $tmpdir = &util::get_tmp_filename ();
90 &util::mk_all_dir ($tmpdir);
91
92 print $outhandle "ZIPPlug: extracting $file_only to $tmpdir\n";
93
94 # save current working directory
95 my $cwd = cwd();
96 chdir ($tmpdir) || die "Unable to change to $tmpdir";
97 &util::cp ($filename, $tmpdir);
98
99 if ($file =~ /\.bz$/i) {
100 $self->bunzip ($file_only);
101 } elsif ($file =~ /\.bz2$/i) {
102 $self->bunzip2 ($file_only);
103 } elsif ($file =~ /\.(zip|jar)$/i) {
104 $self->unzip ($file_only);
105 } elsif ($file =~ /\.tar$/i) {
106 $self->untar ($file_only);
107 } else {
108 $self->gunzip ($file_only);
109 }
110
111 chdir ($cwd) || die "Unable to change back to $cwd";
112
113 my $numdocs = &plugin::read ($pluginfo, "", $tmpdir, $metadata, $processor, $maxdocs);
114 &util::rm_r ($tmpdir);
115
116 $self->{'num_archives'} ++;
117
118 return $numdocs;
119
120 } else {
121 return undef;
122 }
123}
124
125sub bunzip {
126 my $self = shift (@_);
127 my ($file) = @_;
128
129 if (system ("bunzip $file")!=0)
130 {
131 &util::rm ($file);
132 }
133}
134
135sub bunzip2 {
136 my $self = shift (@_);
137 my ($file) = @_;
138
139 if (system ("bunzip2 $file")!=0)
140 {
141 &util::rm ($file);
142 }
143}
144
145sub unzip {
146 my $self = shift (@_);
147 my ($file) = @_;
148
149 system ("unzip $file");
150 &util::rm ($file) if -e $file;
151}
152
153sub untar {
154 my $self = shift (@_);
155 my ($file) = @_;
156
157 system ("tar xf $file");
158 &util::rm ($file) if -e $file;
159}
160
161sub gunzip {
162 my $self = shift (@_);
163 my ($file) = @_;
164
165 if (system ("gunzip $file")!=0)
166 {
167 &util::rm ($file);
168 };
169}
170
1711;
Note: See TracBrowser for help on using the repository browser.