source: gsdl/trunk/bin/script/filecopy.pl@ 14925

Last change on this file since 14925 was 14925, checked in by dmn, 15 years ago

davidbs changes to update for gs3 building

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 6.0 KB
Line 
1#!/usr/bin/perl -w
2
3###########################################################################
4#
5# filecopy.pl --
6# A component of the Greenstone digital library software
7# from the New Zealand Digital Library Project at the
8# University of Waikato, New Zealand.
9#
10# Copyright (C) 1999 New Zealand Digital Library Project
11#
12# This program is free software; you can redistribute it and/or modify
13# it under the terms of the GNU General Public License as published by
14# the Free Software Foundation; either version 2 of the License, or
15# (at your option) any later version.
16#
17# This program is distributed in the hope that it will be useful,
18# but WITHOUT ANY WARRANTY; without even the implied warranty of
19# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20# GNU General Public License for more details.
21#
22# You should have received a copy of the GNU General Public License
23# along with this program; if not, write to the Free Software
24# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25#
26###########################################################################
27
28
29# This program will "download" the specified files/directories
30
31BEGIN {
32 die "GSDLHOME not set\n" unless defined $ENV{'GSDLHOME'};
33 unshift (@INC, "$ENV{'GSDLHOME'}/perllib");
34}
35
36use util;
37use parsargv;
38use File::stat;
39use File::Basename;
40use FileHandle;
41
42sub print_usage {
43 print STDERR "\n";
44 print STDERR "filecopy.pl: Recursively copies files into a collections import directory.\n\n";
45 print STDERR "\n usage: $0 [options] [directories] collection-name\n\n";
46
47 print STDERR " options:\n";
48 print STDERR " -follow_links Follow symbolic links when recursing directory\n";
49 print STDERR " structure\n";
50 print STDOUT " -collectdir directory Collection directory (defaults to " .
51 &util::filename_cat($ENV{'GSDLHOME'}). "collect for Greenstone2;\n";
52 print STDOUT" for Greenstone3 use -site option and then collectdir default will be\n";
53 print STDOUT " set to the collect folder within that site.)\n";
54 print STDOUT " -site Specify the site within a Greenstone3 installation to use.\n";
55 print STDERR " -out Filename or handle to print output status to.\n";
56 print STDERR " The default is STDERR\n\n";
57}
58
59sub get_file_list {
60 my $dirhash = shift @_;
61 my $filehash = shift @_;
62 my $dirname = shift @_;
63
64 my $full_importname
65 = &util::filename_cat($collectdir, $dirname, "import");
66
67 # check for .kill file
68 if (-e &util::filename_cat($collectdir, $dirname, ".kill")) {
69 print $out "filecopy.pl killed by .kill file\n";
70 die "\n";
71 }
72
73 foreach my $file (@_) {
74
75 $file =~ s/^\"//;
76 $file =~ s/\"$//;
77
78 if (!$follow_links && -l $file) {
79 # do nothing as we don't want to follow symbolic links
80
81 } elsif (-d $file) {
82 my $dst_dir = &get_dst_dir ($full_importname, $file);
83 # add this directory to the list to be created
84 $dirhash->{$dst_dir} = 1;
85
86 # read in dir
87 if (!opendir (DIR, $file)) {
88 print $out "Error: Could not open directory $file\n";
89 } else {
90 my @sub_files = grep (!/^\.\.?$/, readdir (DIR));
91 closedir DIR;
92 map { $_ = &util::filename_cat($file, $_); } @sub_files;
93 &get_file_list($dirhash, $filehash, $dirname, @sub_files);
94 }
95
96 } else {
97 my $dst_file = &get_dst_dir ($full_importname, $file);
98
99 # make sure files directory is included in dirhash
100 $dirhash->{File::Basename::dirname($dst_file)} = 1;
101
102 if (-e $dst_file) {
103 # if destination file exists already we'll only copy it if
104 # the source file is newer
105 my $src_stat = stat($file);
106 my $dst_stat = stat($dst_file);
107 $filehash->{$file} = $dst_file if ($src_stat->mtime > $dst_stat->mtime);
108 } else {
109 $filehash->{$file} = $dst_file;
110 }
111 }
112 }
113}
114
115
116sub main {
117
118 if (!parsargv::parse(\@ARGV,
119 'follow_links', \$follow_links,
120 'collectdir/.*/', \$collectdir,
121 'site/.*/', \$site,
122 'out/.*/STDERR', \$out)) {
123 &print_usage();
124 die "\n";
125 }
126
127
128 if (defined $site)
129 {
130 die "GSDL3HOME not set." unless $ENV{'GSDL3HOME'};
131 $collectdir = &util::filename_cat ($ENV{'GSDL3HOME'}, "sites", $site, "collect") unless $collectdir =~ /\w/;
132 }
133 else
134 {
135 $collectdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect") unless $collectdir =~ /\w/;
136 }
137
138 my $collection = pop @ARGV;
139
140 my $close_out = 0;
141 if ($out !~ /^(STDERR|STDOUT)$/i) {
142 open (OUT, ">$out") || die "Couldn't open output file $out\n";
143 $out = OUT;
144 $close_out = 1;
145 }
146 $out->autoflush(1);
147
148 # first compile a list of all the files we want to copy (we do it this
149 # way rather than simply copying the files as we recurse the directory
150 # structure to avoid nasty infinite recursion if the directory we're
151 # copying to happens to be a subdirectory of one of the directories
152 # we're copying from)
153 my $dirhash = {};
154 my $filehash = {};
155 &get_file_list($dirhash, $filehash, $collection, @ARGV);
156
157 # create all the required destination directories
158 my $count = 0;
159 foreach my $dir (keys %$dirhash) {
160 # check for .kill file
161 if (($count ++ % 20 == 0) &&
162 (-e &util::filename_cat($collectdir, $collection, ".kill"))) {
163 print $out "filecopy.pl killed by .kill file\n";
164 die "\n";
165 }
166 &util::mk_all_dir($dir);
167 }
168
169 # copy all the files
170 foreach my $file (keys %$filehash) {
171 # check for .kill file
172 if (($count ++ % 20 == 0) &&
173 (-e &util::filename_cat($collectdir, $collection, ".kill"))) {
174 print $out "filecopy.pl killed by .kill file\n";
175 die "\n";
176 }
177 print $out "copying $file --> $filehash->{$file}\n";
178 &util::cp($file, $filehash->{$file});
179 }
180
181 close OUT if $close_out;
182 return 0;
183}
184
185sub get_dst_dir {
186 my ($full_importname, $dir) = @_;
187
188 if ($ENV{'GSDLOS'} eq "windows") {
189 # don't want windows filenames like c:\gsdl\...\import\c:\dir
190 $dir =~ s/^[a-z]:[\\\/]//i;
191 }
192 return &util::filename_cat($full_importname, $dir);
193}
194
195&main();
Note: See TracBrowser for help on using the repository browser.