|
0
|
1 #!/usr/local/bin/perl -w
|
|
|
2
|
|
|
3 use strict;
|
|
|
4 use XML::SAX;
|
|
3
|
5 use XML::LibXML;
|
|
0
|
6 use DBI;
|
|
|
7
|
|
4
|
8 use lib '/usr/local/mpiwg/archive';
|
|
0
|
9 use MPIWGStor;
|
|
|
10 use HarvestmetaHandler;
|
|
|
11
|
|
|
12 # make output unbuffered
|
|
|
13 $|=1;
|
|
|
14
|
|
|
15 #######################################################
|
|
|
16 # internal parameters
|
|
|
17 #
|
|
|
18
|
|
|
19 # program version
|
|
6
|
20 my $version = "0.2.1 (13.07.2004)";
|
|
0
|
21
|
|
|
22 # read command line parameters
|
|
|
23 my $args = MPIWGStor::parseargs;
|
|
|
24
|
|
3
|
25 if (! scalar(%$args)) {
|
|
|
26 print "harvestmeta $version\n";
|
|
|
27 print "use: harvestmeta -path=dir\n";
|
|
|
28 print " reads all metadata info from directory dir into the database\n";
|
|
|
29 print "alternative sources:\n";
|
|
|
30 print " -indexurl=url : read XML index and follow links\n";
|
|
|
31 print " -singleurl=url : read single index file\n";
|
|
|
32 print "additional options:\n";
|
|
|
33 print " -baseurl=url : clean all URL sources relative to this base\n";
|
|
|
34 print " -debug : output debugging info\n";
|
|
|
35 print " -purgedb : clear whole database\n";
|
|
|
36 exit 1;
|
|
|
37 }
|
|
|
38
|
|
0
|
39 # debug level
|
|
|
40 $debug = (exists $$args{'debug'}) ? $$args{'debug'} : 0;
|
|
|
41
|
|
|
42 # XML namespace (not really implemented!)
|
|
|
43 my $namespace = "";
|
|
|
44
|
|
|
45 # delete and rebuild database
|
|
|
46 my $purgeDB = (exists $$args{'purgedb'});
|
|
|
47
|
|
|
48 # database connection
|
|
|
49 my $dbh = DBI->connect("dbi:Pg:dbname=storage", "archiver", "");
|
|
|
50 if (! $dbh) {
|
|
|
51 logger('ABORT', "unable to connect to database!");
|
|
|
52 exit 1;
|
|
|
53 }
|
|
|
54 $dbh->{AutoCommit} = 0;
|
|
|
55 my $dbNextFileId;
|
|
|
56 my $dbNewFile;
|
|
|
57 my $dbNewMeta;
|
|
|
58 my $dbClearMeta;
|
|
|
59 my $dbFindFileName;
|
|
|
60 my $dbFindFilePath;
|
|
|
61 my $dbClearFile;
|
|
|
62 my $dbFindFileFlag;
|
|
|
63 my $dbFindFileFlagPath;
|
|
|
64 my $dbSetFileFlag;
|
|
|
65 my $dbClearAllFileFlag;
|
|
|
66
|
|
|
67 #######################################################
|
|
|
68 # check parameters that were passed to the program
|
|
|
69 #
|
|
3
|
70 my $baseurl;
|
|
|
71 my $indexurl;
|
|
|
72 my $singleurl;
|
|
0
|
73 my $basedir = $$args{'path'};
|
|
3
|
74 if ($basedir) {
|
|
|
75 # strip trailing slashes
|
|
|
76 $basedir =~ s/\/$//;
|
|
|
77 if (! -d $basedir) {
|
|
|
78 logger("ABORT", "document directory \'$basedir\' doesn't exist!");
|
|
|
79 exit 1;
|
|
|
80 }
|
|
|
81 } else {
|
|
|
82 # use URL
|
|
|
83 $baseurl = $$args{'baseurl'};
|
|
|
84 $indexurl = $$args{'indexurl'};
|
|
|
85 $singleurl = $$args{'url'};
|
|
|
86 if (! (($indexurl)||($singleurl))) {
|
|
|
87 logger("ABORT", "no document source given!");
|
|
|
88 exit 1;
|
|
|
89 }
|
|
0
|
90 }
|
|
|
91
|
|
|
92 my $metaParserHandler = HarvestmetaHandler->new;
|
|
|
93 my $metaParser = XML::SAX::ParserFactory->parser(Handler => $metaParserHandler);
|
|
|
94
|
|
|
95 #######################################################
|
|
|
96 # internal variables
|
|
|
97 #
|
|
|
98
|
|
|
99 # number of errors
|
|
|
100 my $errcnt = 0;
|
|
|
101 # number of warnings
|
|
|
102 my $warncnt = 0;
|
|
|
103
|
|
|
104 # number of files on fs
|
|
|
105 my $fcnt = 0;
|
|
|
106 # number of index files
|
|
|
107 my $idxcnt = 0;
|
|
|
108
|
|
|
109 #######################################################
|
|
|
110 # subroutines
|
|
|
111 #
|
|
|
112
|
|
|
113 #
|
|
|
114 # readAllFiles($realdir, $basedir, \%files, \%dirs)
|
|
|
115 #
|
|
|
116 # reads all files and directories below $realdir and puts the
|
|
|
117 # files in %files and directories in %dirs
|
|
|
118 # $basedir is only for recursion, it should be empty when called
|
|
|
119 # from outside
|
|
|
120 #
|
|
|
121 sub readAllFiles {
|
|
|
122 my ($directory, $basedir) = @_;
|
|
|
123 my $cnt = 0;
|
|
|
124
|
|
|
125 if (! opendir DIR, $directory) {
|
|
|
126 return 0;
|
|
|
127 }
|
|
|
128 my @dirfiles = readdir DIR;
|
|
|
129 foreach my $fn (@dirfiles) {
|
|
|
130 # ignore names starting with a dot
|
|
|
131 next if ($fn =~ /^\./);
|
|
|
132 # ignore other silly files
|
|
|
133 next if ($junk_files{$fn});
|
|
|
134
|
|
|
135 $cnt++;
|
|
|
136 $fcnt++;
|
|
|
137 my $f = "$directory/$fn";
|
|
|
138 my $docf = ($basedir) ? "$basedir/$fn" : $fn;
|
|
|
139 #logger('DEBUG', "fs_file: \"$f\"");
|
|
|
140 if (-f $f) {
|
|
|
141 #logger(" is file");
|
|
|
142 if ($fn eq "index.meta") {
|
|
|
143 harvestFile($fn, $directory);
|
|
|
144 }
|
|
|
145 } elsif (-d _) {
|
|
|
146 #logger(" is dir");
|
|
|
147 # recurse into directory
|
|
|
148 $cnt += readAllFiles($f, $docf);
|
|
|
149 }
|
|
|
150 }
|
|
|
151 return $cnt;
|
|
|
152 }
|
|
|
153
|
|
|
154 #
|
|
|
155 # cleanUnmarkedFiles($basepath)
|
|
|
156 #
|
|
|
157 # deletes all unflagged file and meta entries.
|
|
|
158 #
|
|
|
159 sub cleanUnmarkedFiles {
|
|
|
160 my ($basepath) = @_;
|
|
|
161 my $rv = $dbFindFileFlagPath->execute("${basepath}%");
|
|
|
162 my $ids = $dbFindFileFlagPath->fetchall_arrayref;
|
|
|
163 for my $i (@$ids) {
|
|
|
164 my $id = $$i[0];
|
|
|
165 logger('DEBUG', "cleaning file and meta of id: $id");
|
|
|
166 $dbClearMeta->execute($id);
|
|
|
167 $dbClearFile->execute($id);
|
|
|
168 $dbh->commit;
|
|
|
169 }
|
|
|
170 }
|
|
|
171
|
|
|
172 #
|
|
|
173 # harvestFile($filename, $filepath)
|
|
|
174 #
|
|
|
175 # reads the index file $filename at $filepath and puts the contents
|
|
|
176 # in the database.
|
|
|
177 #
|
|
|
178 sub harvestFile {
|
|
|
179 my ($filename, $filepath) = @_;
|
|
|
180 logger('DEBUG', "looking at file '$filename' at '$filepath'");
|
|
|
181 # get file time
|
|
|
182 my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
|
|
|
183 $atime,$mtime,$ctime,$blksize,$blocks)
|
|
|
184 = stat("$filepath/$filename");
|
|
|
185 my $filetime = stime($mtime);
|
|
|
186 # register file in db
|
|
|
187 my $fid = registerFile("$filepath/$filename", $filetime);
|
|
|
188 if ($fid) {
|
|
|
189 # file is new/modified
|
|
|
190 # parse index file
|
|
3
|
191 my $ret = eval{$metaParser->parse_uri("$filepath/$filename")};
|
|
|
192 if ($@) {
|
|
|
193 my $errmsg = $@;
|
|
|
194 logger('ERROR', "error reading XML file '$filepath/$filename' ($errmsg)");
|
|
|
195 $errcnt++;
|
|
|
196 return;
|
|
|
197 }
|
|
0
|
198 my @data = $metaParserHandler->getData();
|
|
|
199 logger('DEBUG', "parsed $#data+1 elements");
|
|
3
|
200 if ($data[0][0] eq "html") {
|
|
|
201 # oops, wrong
|
|
|
202 logger('WARNING', "invalid HTML content in file $filepath/$filename");
|
|
|
203 return;
|
|
|
204 }
|
|
0
|
205 registerMeta($fid, @data);
|
|
|
206 }
|
|
|
207 $idxcnt++;
|
|
|
208 logger('INFO', "$idxcnt index files of $fcnt") if ($idxcnt % 10 == 0) ;
|
|
|
209 }
|
|
|
210
|
|
|
211 #
|
|
3
|
212 # readURLIndex($baseurl)
|
|
|
213 #
|
|
|
214 # reads the XML index at $baseurl
|
|
|
215 # and processes all its entries
|
|
|
216 #
|
|
|
217 sub readURLIndex {
|
|
|
218 my ($baseurl) = @_;
|
|
|
219 my $cnt = 0;
|
|
|
220
|
|
|
221 # parse index file
|
|
|
222 logger('DEBUG', "parsing $baseurl ...");
|
|
|
223 $metaParser->parse_uri($baseurl);
|
|
|
224 my @indexdata = $metaParserHandler->getData();
|
|
|
225 logger('INFO', "parsed $#indexdata+1 index entries");
|
|
|
226
|
|
|
227 foreach my $me (@indexdata) {
|
|
|
228 $cnt++;
|
|
|
229 my ($tag, $val, $attr) = @$me;
|
|
6
|
230 my $meta = "";
|
|
|
231 my $file = "";
|
|
3
|
232 if ($tag =~ /index\/resource$/) {
|
|
|
233 if ($attr =~ /metaLink=\"([^\"]+)\"/) {
|
|
|
234 $meta = $1;
|
|
|
235 }
|
|
|
236 if ($attr =~ /resourceLink=\"([^\"]+)\"/) {
|
|
|
237 $file = $1;
|
|
|
238 }
|
|
|
239 if ($meta =~ /^http:/) {
|
|
|
240 harvestURL($meta, $file);
|
|
|
241 }
|
|
|
242 }
|
|
|
243 }
|
|
|
244 return $cnt;
|
|
|
245 }
|
|
|
246
|
|
|
247 #
|
|
|
248 # harvestURL($metaurl, $fileurl)
|
|
|
249 #
|
|
|
250 # reads the index file from $metaurl and puts the contents
|
|
|
251 # in the database (under $filepath)
|
|
|
252 #
|
|
|
253 sub harvestURL {
|
|
|
254 my ($metaurl, $fileurl) = @_;
|
|
|
255 logger('DEBUG', "fetching from url '$metaurl' for '$fileurl'");
|
|
|
256 # try to parse index file
|
|
|
257 my $ret = eval{$metaParser->parse_uri($metaurl)};
|
|
|
258 if ($@) {
|
|
|
259 my $errmsg = $@;
|
|
|
260 logger('ERROR', "error reading XML from '$metaurl' ($errmsg)");
|
|
|
261 $errcnt++;
|
|
|
262 return;
|
|
|
263 }
|
|
|
264 my @data = $metaParserHandler->getData();
|
|
|
265 logger('DEBUG', "parsed $#data+1 elements");
|
|
6
|
266 if (lc $data[0][0] eq "html") {
|
|
3
|
267 # oops, wrong
|
|
|
268 logger('WARNING', "invalid HTML content from $metaurl");
|
|
|
269 $warncnt++;
|
|
|
270 return;
|
|
|
271 }
|
|
|
272 # filetime is now
|
|
|
273 my $filetime = stime(time);
|
|
|
274 # register file in db
|
|
|
275 my $fid = registerFile("$fileurl", $filetime);
|
|
|
276 if ($fid) {
|
|
|
277 # file is new/modified
|
|
|
278 registerMeta($fid, @data);
|
|
|
279 }
|
|
|
280 $idxcnt++;
|
|
|
281 logger('INFO', "$idxcnt index files of $fcnt") if ($idxcnt % 10 == 0) ;
|
|
|
282 }
|
|
|
283
|
|
|
284
|
|
|
285 #
|
|
0
|
286 # $fileid = registerFile($filepath, $filetime)
|
|
|
287 #
|
|
|
288 # returns the file ID for the file $filepath. If necessary it
|
|
|
289 # will be added to the database. returns 0 if an update is not necessary.
|
|
|
290 #
|
|
|
291 sub registerFile {
|
|
|
292 my ($filepath, $filetime) = @_;
|
|
|
293 my $fileid = 0;
|
|
|
294 # look if file is in db
|
|
|
295 my $rv = $dbFindFileName->execute($filepath);
|
|
|
296 my $mtime;
|
|
|
297 ($fileid, $mtime) = $dbFindFileName->fetchrow_array;
|
|
|
298 if ($fileid) {
|
|
|
299 # file is in db
|
|
|
300 # update flag
|
|
|
301 $dbSetFileFlag->execute($fileid, 1);
|
|
|
302 $dbh->commit;
|
|
|
303 my $stime = s2stime($mtime);
|
|
|
304 if ($stime ge $filetime) {
|
|
|
305 # if its current return 0
|
|
|
306 logger('DEBUG', "file: $fileid is old! time: '$stime' (vs '$filetime')");
|
|
|
307 return 0;
|
|
|
308 } else {
|
|
|
309 logger('DEBUG', "file: $fileid is new! time: '$stime' (vs '$filetime')");
|
|
|
310 }
|
|
|
311 }
|
|
|
312 if (! $fileid) {
|
|
|
313 # get a new file id
|
|
|
314 my $rv = $dbNextFileId->execute;
|
|
|
315 ($fileid) = $dbNextFileId->fetchrow_array;
|
|
|
316 logger('DEBUG', "DB newfile: id=$fileid filename=$filepath mtime=$filetime");
|
|
|
317 $dbNewFile->execute($fileid, $filepath, $filetime);
|
|
|
318 # update flag
|
|
|
319 $dbSetFileFlag->execute($fileid, 1);
|
|
|
320 $dbh->commit;
|
|
|
321 }
|
|
|
322 return $fileid;
|
|
|
323 }
|
|
|
324
|
|
|
325 #
|
|
|
326 # registerMeta($fileid, @meta)
|
|
|
327 #
|
|
|
328 # adds the metadata information @meta for $fileid to the database.
|
|
|
329 #
|
|
|
330 sub registerMeta {
|
|
|
331 my ($fileid, @meta) = @_;
|
|
|
332 logger('DEBUG', "DB newmeta: fileid=$fileid ($#meta)");
|
|
3
|
333 # clear out old data
|
|
|
334 $dbClearMeta->execute($fileid);
|
|
0
|
335 my $idx = 0;
|
|
|
336 foreach my $keyval (@meta) {
|
|
|
337 #logger('DEBUG', " DB meta: $$keyval[0]=$$keyval[1]");
|
|
|
338 $dbNewMeta->execute($fileid, $idx++, $$keyval[0], $$keyval[2], $$keyval[1]);
|
|
|
339 }
|
|
|
340 $dbh->commit;
|
|
|
341 logger('INFO', "added $idx elements (file $fileid)");
|
|
|
342 }
|
|
|
343
|
|
|
344 #
|
|
|
345 # initdb()
|
|
|
346 #
|
|
|
347 # initialises the database connection.
|
|
|
348 #
|
|
|
349 sub initDB {
|
|
|
350 my $rv;
|
|
|
351 # clean tables
|
|
|
352 if ($purgeDB) {
|
|
|
353 $rv = $dbh->do("delete from files");
|
|
|
354 $rv = $dbh->do("delete from meta");
|
|
|
355 if ($dbh->err) {
|
|
|
356 logger('ABORT', "unable to clean table!");
|
|
|
357 exit 1;
|
|
|
358 }
|
|
|
359 $dbh->commit;
|
|
|
360 }
|
|
|
361
|
|
|
362 # clear flags
|
|
|
363 $rv = $dbh->do("create temporary table file_flags ( fileid integer primary key, flag integer )");
|
|
|
364 $dbh->commit;
|
|
|
365
|
|
|
366 # prepare statements
|
|
|
367 $dbNextFileId = $dbh->prepare("select nextval('files_id_seq')");
|
|
|
368 $dbNewFile = $dbh->prepare("insert into files (id, filename, mtime) values (?,?,?)");
|
|
|
369 $dbFindFileName = $dbh->prepare("select id,mtime from files where filename=?");
|
|
|
370 $dbFindFilePath = $dbh->prepare("select id,filename,flag from files where filename like ?");
|
|
|
371 $dbClearFile = $dbh->prepare("delete from files where id=?");
|
|
|
372 $dbFindFileFlag = $dbh->prepare("select fileid from file_flags where flag=?");
|
|
|
373 $dbFindFileFlagPath = $dbh->prepare("select id from files left outer join file_flags on files.id=file_flags.fileid where filename like ? and flag is null");
|
|
|
374 $dbSetFileFlag = $dbh->prepare("insert into file_flags (fileid, flag) values (?,?)");
|
|
|
375 $dbNewMeta = $dbh->prepare("insert into meta (fileid, idx, tags, attributes, content) values (?,?,?,?,?)");
|
|
|
376 $dbClearMeta = $dbh->prepare("delete from meta where fileid=?");
|
|
|
377
|
|
|
378 }
|
|
|
379
|
|
|
380 #######################################################
|
|
|
381 # main
|
|
|
382 #
|
|
|
383
|
|
|
384 logger("INFO", "harvestmeta $version");
|
|
|
385
|
|
|
386 initDB();
|
|
6
|
387 my $fnum = 0;
|
|
0
|
388
|
|
3
|
389 if ($basedir) {
|
|
|
390 # read and process all files under $basedir
|
|
|
391 $fnum = readAllFiles($basedir, "");
|
|
|
392 # delete orphaned data (under $basedir)
|
|
|
393 cleanUnmarkedFiles($basedir);
|
|
6
|
394 } elsif ($indexurl) {
|
|
3
|
395 # read and process XML index
|
|
|
396 $fnum = readURLIndex($indexurl);
|
|
|
397 if ($baseurl) {
|
|
|
398 # delete orphaned data (under $baseurl)
|
|
|
399 cleanUnmarkedFiles($baseurl);
|
|
|
400 }
|
|
|
401 } elsif ($singleurl) {
|
|
|
402 # read and process single XML url
|
|
|
403 harvestURL($singleurl, $singleurl);
|
|
|
404 $fnum = 1;
|
|
|
405 if ($baseurl) {
|
|
|
406 # delete orphaned data (under $baseurl)
|
|
|
407 cleanUnmarkedFiles($baseurl);
|
|
|
408 }
|
|
|
409 }
|
|
0
|
410
|
|
|
411 logger("INFO", "analysed $idxcnt of $fnum files!");
|
|
|
412 logger("INFO", "$warncnt warnings");
|
|
|
413 logger("INFO", "$errcnt errors");
|
|
|
414 if ($errcnt > 0) {
|
|
|
415 logger("ABORT", "there were errors!");
|
|
|
416 exit 1;
|
|
|
417 } else {
|
|
|
418 logger("DONE", "all index files read successfully!");
|
|
|
419 }
|
