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

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

Fixed a minor bug in the collector

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 4.3 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 " -collectdir directory Collection directory (defaults to " .
49 &util::filename_cat ($ENV{'GSDLHOME'}, "collect") . ")\n";
50 print STDERR " -out Filename or handle to print output status to.\n";
51 print STDERR " The default is STDERR\n\n";
52}
53
54sub download_files
55{
56 my $dirname = pop(@_);
57 my $full_importname
58 = &util::filename_cat($collectdir, $dirname, "import");
59
60 # split argv into 2 lists: files and directories
61 my (@files,@dirs) = ((),());
62 my $a;
63 foreach $a (@_)
64 {
65 $a =~ s/^\"//;
66 $a =~ s/\"$//;
67
68 if (-e $a)
69 {
70 if (-d $a)
71 {
72 push(@dirs,$a);
73 }
74 else
75 {
76 push(@files,$a);
77 }
78 }
79 else
80 {
81 print $out "Error: filename '$a' does not exist\n";
82 }
83 }
84
85 if (scalar(@files)>0)
86 {
87 my $f;
88 foreach $f (@files)
89 {
90 my $src_file = $f;
91 my $dst_file = &get_dst_dir ($full_importname,$f);
92
93 my $do_copy = "no";
94 if (-e $dst_file)
95 {
96 # compare file dates
97 my $src_stat = stat($src_file);
98 my $dst_stat = stat($dst_file);
99
100 if ($src_stat->mtime > $dst_stat->mtime)
101 {
102 $do_copy = "yes";
103 }
104 }
105 else
106 {
107 $do_copy = "yes";
108 }
109
110 if ($do_copy eq "yes")
111 {
112 my $dst_dir = &File::Basename::dirname($dst_file);
113 &util::mk_all_dir($dst_dir) unless -d $dst_dir;
114 print $out "Copying $src_file-->$dst_file\n";
115 &util::cp($src_file,$dst_file);
116 }
117 }
118 }
119
120
121 if (scalar(@dirs)>0)
122 {
123 my $d;
124 foreach $d (@dirs)
125 {
126 my $src_dir = $d;
127 my $dst_dir = &get_dst_dir ($full_importname, $d);
128 if (!-e $dst_dir)
129 {
130 # create it if it doesn't exist
131 &util::mk_all_dir($dst_dir);
132 }
133
134 # read in dir
135 if (!opendir (INDIR, $d))
136 {
137 print $out "Error: Could not open directory $d\n";
138 }
139 else
140 {
141 my @sub_files = grep (!/^\.\.?$/, readdir (INDIR));
142 closedir (INDIR);
143
144 map { $_ = &util::filename_cat($d,$_); } @sub_files;
145 download_files(@sub_files,$dirname);
146 }
147 }
148 }
149}
150
151sub main
152{
153 if (!parsargv::parse(\@ARGV,
154 'collectdir/.*/', \$collectdir,
155 'out/.*/STDERR', \$out)) {
156 &print_usage();
157 die "\n";
158 }
159
160 if ($collectdir !~ /\w/) {
161 $collectdir = &util::filename_cat ($ENV{'GSDLHOME'}, "collect");
162 }
163
164 my $close_out = 0;
165 if ($out !~ /^(STDERR|STDOUT)$/i) {
166 open (OUT, ">$out") || die "Couldn't open output file $out\n";
167 $out = OUT;
168 $close_out = 1;
169 }
170 $out->autoflush(1);
171
172 download_files(@ARGV);
173
174 close OUT if $close_out;
175 return 0;
176}
177
178sub get_dst_dir {
179 my ($full_importname, $dir) = @_;
180
181 if ($ENV{'GSDLOS'} eq "windows") {
182 # don't want windows filenames like c:\gsdl\...\import\c:\dir
183 $dir =~ s/^[a-z]:[\\\/]//i;
184 }
185 return &util::filename_cat($full_importname,$dir);
186}
187
188&main();
Note: See TracBrowser for help on using the repository browser.