root/main/trunk/greenstone2/perllib/plugins/DirectoryPlugin.pm @ 29795

Revision 29795, 23.3 KB (checked in by kjdon, 5 years ago)

change to using util method raw_filename_to_unicode. got this working on windows, now have to try again on linux and mac...

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
Line 
1###########################################################################
2#
3# DirectoryPlugin.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# DirectoryPlugin is a plugin which recurses through directories processing
27# each file it finds - which basically means passing it down the plugin
28# pipeline
29
30package DirectoryPlugin;
31
32use extrametautil;
33use PrintInfo;
34use plugin;
35use util;
36use FileUtils;
37use metadatautil;
38
39use File::Basename;
40use strict;
41no strict 'refs';
42no strict 'subs';
43
44use Encode::Locale;
45use Encode;
46use Unicode::Normalize;
47
48use Win32;
49
50BEGIN {
51    @DirectoryPlugin::ISA = ('PrintInfo');
52}
53
54my $arguments =
55    [ { 'name' => "block_exp",
56    'desc' => "{BasePlugin.block_exp}",
57    'type' => "regexp",
58    'deft' => &get_default_block_exp(),
59    'reqd' => "no" },
60      # this option has been deprecated. leave it here for now so we can warn people not to use it
61      { 'name' => "use_metadata_files",
62    'desc' => "{DirectoryPlugin.use_metadata_files}",
63    'type' => "flag",
64    'reqd' => "no",
65    'hiddengli' => "yes" },
66      { 'name' => "recheck_directories",
67    'desc' => "{DirectoryPlugin.recheck_directories}",
68    'type' => "flag",
69    'reqd' => "no" } ];
70   
71my $options = { 'name'     => "DirectoryPlugin",
72        'desc'     => "{DirectoryPlugin.desc}",
73        'abstract' => "no",
74        'inherits' => "yes",
75        'args'     => $arguments };
76
77sub new {
78    my ($class) = shift (@_);
79    my ($pluginlist,$inputargs,$hashArgOptLists) = @_;
80    push(@$pluginlist, $class);
81
82    push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
83    push(@{$hashArgOptLists->{"OptList"}},$options);
84
85    my $self = new PrintInfo($pluginlist, $inputargs, $hashArgOptLists);
86   
87    if ($self->{'info_only'}) {
88    # don't worry about any options or initialisations etc
89    return bless $self, $class;
90    }
91
92    # we have left this option in so we can warn people who are still using it
93    if ($self->{'use_metadata_files'}) {
94    die "ERROR: DirectoryPlugin -use_metadata_files option has been deprecated. Please remove the option and add MetadataXMLPlug to your plugin list instead!\n";
95    }
96   
97    $self->{'num_processed'} = 0;
98    $self->{'num_not_processed'} = 0;
99    $self->{'num_blocked'} = 0;
100    $self->{'num_archives'} = 0;
101
102    $self->{'subdir_extrametakeys'} = {};
103
104    return bless $self, $class;
105}
106
107# called once, at the start of processing
108sub init {
109    my $self = shift (@_);
110    my ($verbosity, $outhandle, $failhandle) = @_;
111
112    # verbosity is passed through from the processor
113    $self->{'verbosity'} = $verbosity;
114
115    # as are the outhandle and failhandle
116    $self->{'outhandle'} = $outhandle if defined $outhandle;
117    $self->{'failhandle'} = $failhandle;
118
119}
120
121# called once, after all passes have finished
122sub deinit {
123    my ($self) = @_;
124
125}
126
127# called at the beginning of each plugin pass (import has one, building has many)
128sub begin {
129    my $self = shift (@_);
130    my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
131
132    # Only lookup timestamp info for import.pl, and only if incremental is set
133    my $proc_package_name = ref $processor;
134    if ($proc_package_name !~ /buildproc$/ && $self->{'incremental'} == 1) {
135        # Get the infodbtype value for this collection from the arcinfo object
136        my $infodbtype = $processor->getoutputinfo()->{'infodbtype'};
137    $infodbtype = "gdbm" if $infodbtype eq "gdbm-txtgz"; # in archives, cannot use txtgz version
138    my $output_dir = $processor->getoutputdir();
139        my $archives_inf = &dbutil::get_infodb_file_path($infodbtype, "archiveinf-doc", $output_dir);
140
141    if ( -e $archives_inf ) {
142        $self->{'inf_timestamp'} = -M $archives_inf;
143    }
144    }
145}
146
147sub remove_all {
148    my $self = shift (@_);
149    my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;
150}
151
152
153sub remove_one {
154    my $self = shift (@_);
155    my ($file, $oids, $archivedir) = @_;
156    return undef; # this will never be called for directories (will it??)
157
158}
159
160
161# called at the end of each plugin pass
162sub end {
163    my ($self) = shift (@_);
164
165}
166
167
168
169# return 1 if this class might recurse using $pluginfo
170sub is_recursive {
171    my $self = shift (@_);
172   
173    return 1;
174}
175
176sub get_default_block_exp {
177    my $self = shift (@_);
178   
179    return '(?i)(CVS|\.svn|Thumbs\.db|OIDcount|\.DS_Store|~)$';
180}
181
182sub check_directory_path {
183
184    my $self = shift(@_);
185    my ($dirname) = @_;
186   
187    return undef unless (-d $dirname);
188
189    return 0 if ($self->{'block_exp'} ne "" && $dirname =~ /$self->{'block_exp'}/);
190
191    my $outhandle = $self->{'outhandle'};
192   
193    # check to make sure we're not reading the archives or index directory
194    my $gsdlhome = quotemeta($ENV{'GSDLHOME'});
195    if ($dirname =~ m/^$gsdlhome\/.*?\/import.*?\/(archives|index)$/) {
196    print $outhandle "DirectoryPlugin: $dirname appears to be a reference to a Greenstone collection, skipping.\n";
197        return 0;
198    }
199   
200    # check to see we haven't got a cyclic path...
201    if ($dirname =~ m%(/.*){,41}%) {
202    print $outhandle "DirectoryPlugin: $dirname is 40 directories deep, is this a recursive path? if not increase constant in DirectoryPlugin.pm.\n";
203    return 0;
204    }
205   
206    # check to see we haven't got a cyclic path...
207    if ($dirname =~ m%.*?import/(.+?)/import/\1.*%) {
208    print $outhandle "DirectoryPlugin: $dirname appears to be in a recursive loop...\n";
209    return 0;
210    }
211
212    return 1;
213}
214
215# this may be called more than once
216sub sort_out_associated_files {
217
218    my $self = shift (@_);
219    my ($block_hash) = @_;
220    if (!scalar (keys %{$block_hash->{'shared_fileroot'}})) {
221    return;
222    }
223
224    $self->{'assocfile_info'} = {} unless defined $self->{'assocfile_info'};
225    my $metadata = $self->{'assocfile_info'};
226    foreach my $prefix (keys %{$block_hash->{'shared_fileroot'}}) {
227    my $record = $block_hash->{'shared_fileroot'}->{$prefix};
228
229    my $tie_to = $record->{'tie_to'};
230    my $exts = $record->{'exts'};
231   
232    if ((defined $tie_to) && (scalar (keys %$exts) > 0)) {
233        # set up fileblocks and assocfile_tobe
234        my $base_file = "$prefix$tie_to";
235        $metadata->{$base_file} = {} unless defined $metadata->{$base_file};
236        my $base_file_metadata = $metadata->{$base_file};
237       
238        $base_file_metadata->{'gsdlassocfile_tobe'} = [] unless defined $base_file_metadata->{'gsdlassocfile_tobe'};
239        my $assoc_tobe = $base_file_metadata->{'gsdlassocfile_tobe'};
240        foreach my $e (keys %$exts) {
241        # block the file
242        &util::block_filename($block_hash,"$prefix$e");
243        # set up as an associatd file
244        print STDERR "  $self->{'plugin_type'}: Associating $prefix$e with $tie_to version\n";
245        my $mime_type = ""; # let system auto detect this
246        push(@$assoc_tobe,"$prefix$e:$mime_type:");
247
248        }
249    }
250    } # foreach record
251
252    $block_hash->{'shared_fileroot'} = undef;
253    $block_hash->{'shared_fileroot'} = {};
254
255}
256
257
258# do block exp OR special blocking ???
259
260sub file_is_blocked {
261    my $self = shift (@_);
262    my ($block_hash, $filename_full_path) = @_;
263
264    $filename_full_path = &util::upgrade_if_dos_filename($filename_full_path);
265
266    if (($ENV{'GSDLOS'} =~ m/^windows$/) && ($^O ne "cygwin")) {
267    # on windows, all block paths are lowercased.
268    my $lower_filename = lc ($filename_full_path);
269    if (defined $block_hash->{'file_blocks'}->{$lower_filename}) {
270        $self->{'num_blocked'} ++;
271        return 1;
272    }
273    }
274    else {
275    if (defined $block_hash->{'file_blocks'}->{$filename_full_path}) {
276        $self->{'num_blocked'} ++;
277        return 1;
278    }
279    }
280    # check Directory plugin's own block_exp
281    if ($self->{'block_exp'} ne "" && $filename_full_path =~ /$self->{'block_exp'}/) {
282    $self->{'num_blocked'} ++;
283    return 1; # blocked
284    }
285    return 0;
286}
287
288
289
290sub file_block_read {
291    my $self = shift (@_);
292    my ($pluginfo, $base_dir, $file, $block_hash, $metadata, $gli) = @_;
293
294    my $outhandle = $self->{'outhandle'};
295    my $verbosity = $self->{'verbosity'};
296   
297    # Calculate the directory name and ensure it is a directory and
298    # that it is not explicitly blocked.
299    my $dirname = $file;
300    $dirname = &FileUtils::filenameConcatenate($base_dir, $file) if $base_dir =~ /\w/;
301
302    my $directory_ok = $self->check_directory_path($dirname);
303    return $directory_ok unless (defined $directory_ok && $directory_ok == 1);
304
305    print $outhandle "Global file scan checking directory: $dirname\n";
306
307    $block_hash->{'all_files'} = {} unless defined $block_hash->{'all_files'};
308    $block_hash->{'metadata_files'} = {} unless defined $block_hash->{'metadata_files'};
309
310    $block_hash->{'file_blocks'} = {} unless defined $block_hash->{'file_blocks'};
311    $block_hash->{'shared_fileroot'} = {} unless defined $block_hash->{'shared_fileroot'};
312
313     # Recur over directory contents.
314    my (@dir, $subfile);
315    #my $count = 0;
316   
317    print $outhandle "DirectoryPlugin block: getting directory $dirname\n" if ($verbosity > 2);
318   
319    # find all the files in the directory
320    if (!opendir (DIR, $dirname)) {
321    if ($gli) {
322        print STDERR "<ProcessingError n='$file' r='Could not read directory $dirname'>\n";
323    }
324    print $outhandle "DirectoryPlugin: WARNING - couldn't read directory $dirname\n";
325    return -1; # error in processing
326    }
327    @dir = sort readdir (DIR);
328    closedir (DIR);
329   
330    for (my $i = 0; $i < scalar(@dir); $i++) {
331    my $raw_subfile = $dir[$i];
332    next if ($raw_subfile =~ m/^\.\.?$/);
333
334    my $this_file_base_dir = $base_dir;
335    my $raw_file_subfile = &FileUtils::filenameConcatenate($file, $raw_subfile);
336
337    # Recursively read each $raw_subfile
338    print $outhandle "DirectoryPlugin block recurring: ". Encode::decode("utf8", $raw_file_subfile) ."\n" if ($verbosity > 2);
339    print $outhandle "DirectoryPlugin block recurring: ". Encode::decode(locale =>$raw_file_subfile) ."\n" if ($verbosity > 2);
340   
341    #$count += &plugin::file_block_read ($pluginfo, $this_file_base_dir,
342
343    &plugin::file_block_read ($pluginfo, $this_file_base_dir,
344                  $raw_file_subfile,
345                  $block_hash, $metadata, $gli);
346   
347    }
348    $self->sort_out_associated_files($block_hash);
349    #return $count;
350    return 1;
351   
352}
353
354# We don't do metadata_read
355sub metadata_read {
356    my $self = shift (@_);
357    my ($pluginfo, $base_dir, $file, $block_hash,
358    $extrametakeys, $extrametadata, $extrametafile,
359    $processor, $gli, $aux) = @_;
360
361    return undef;
362}
363
364
365# return number of files processed, undef if can't process
366# Note that $base_dir might be "" and that $file might
367# include directories
368
369# This function passes around metadata hash structures.  Metadata hash
370# structures are hashes that map from a (scalar) key (the metadata element
371# name) to either a scalar metadata value or a reference to an array of
372# such values.
373
374sub read {
375    my $self = shift (@_);
376    my ($pluginfo, $base_dir, $file, $block_hash, $in_metadata, $processor, $maxdocs, $total_count, $gli) = @_;
377
378    my $outhandle = $self->{'outhandle'};
379    my $verbosity = $self->{'verbosity'};
380
381    # Calculate the directory name and ensure it is a directory and
382    # that it is not explicitly blocked.
383    my $dirname;
384    if ($file eq "") {
385    $dirname = $base_dir;
386    } else {
387    $dirname = $file;
388    $dirname = &FileUtils::filenameConcatenate($base_dir, $file) if $base_dir =~ /\w/;
389    }
390   
391    my $directory_ok = $self->check_directory_path($dirname);
392    return $directory_ok unless (defined $directory_ok && $directory_ok == 1);
393       
394    if (($verbosity > 2) && ((scalar keys %$in_metadata) > 0)) {
395        print $outhandle "DirectoryPlugin: metadata passed in: ",
396    join(", ", keys %$in_metadata), "\n";
397    }
398   
399
400    # Recur over directory contents.
401    my (@dir, $subfile);
402   
403    print $outhandle "DirectoryPlugin read: getting directory $dirname\n" if ($verbosity > 2);
404   
405    # find all the files in the directory
406    if (!opendir (DIR, $dirname)) {
407    if ($gli) {
408        print STDERR "<ProcessingError n='$file' r='Could not read directory $dirname'>\n";
409    }
410    print $outhandle "DirectoryPlugin: WARNING - couldn't read directory $dirname\n";
411    return -1; # error in processing
412    }
413    @dir = sort readdir (DIR);
414    map {  $_ = &unicode::raw_filename_to_url_encoded($_);  print STDERR "****$_\n"; } @dir;
415    closedir (DIR);
416    #$_ = &util::get_dirsep_tail(&util::upgrade_if_dos_filename(&FileUtils::filenameConcatenate($dirname, $_), 1));
417    # Re-order the files in the list so any directories ending with .all are moved to the end
418    for (my $i = scalar(@dir) - 1; $i >= 0; $i--) {
419        #print STDERR "*****file = $dir[$i]\n";
420            #my $long = &Win32::GetLongPathName(&util::filename_cat($dirname,$dir[$i]));
421            #print STDERR "long = $long\n";
422            #my $upgrade = &util::upgrade_if_dos_filename($dir[$i], 1);
423                #print STDERR "upgrade = $upgrade\n";
424    if (-d &FileUtils::filenameConcatenate($dirname, $dir[$i]) && $dir[$i] =~ /\.all$/) {
425        push(@dir, splice(@dir, $i, 1));
426    }
427    }
428
429    # setup the metadata structures. we do a metadata_read pass to see if there is any additional metadata, then pass it to read
430   
431    my $additionalmetadata = 0;      # is there extra metadata available?
432    my %extrametadata;               # maps from filespec to extra metadata keys
433    my %extrametafile;               # maps from filespec to the metadata.xml (or similar) file it came from
434    my @extrametakeys;               # keys of %extrametadata in order read
435
436
437    my $os_dirsep = &util::get_os_dirsep();
438    my $dirsep    = &util::get_dirsep();
439    my $base_dir_regexp = $base_dir;
440    $base_dir_regexp =~ s/\//$os_dirsep/g;
441       
442    # Want to get relative path of local_dirname within the base_directory
443    # but with URL style slashes.
444    my $local_dirname = &util::filename_within_directory_url_format($dirname, $base_dir);
445
446    # if we are in import folder, then local_dirname will be empty
447    if ($local_dirname ne "") {
448    # look for extra metadata passed down from higher folders   
449    $local_dirname .= "/"; # closing slash must be URL type slash also and not $dirsep;
450    if (defined $self->{'subdir_extrametakeys'}->{$local_dirname}) {
451        my $extrakeys = $self->{'subdir_extrametakeys'}->{$local_dirname};
452        foreach my $ek (@$extrakeys) {
453        my $extrakeys_re  = $ek->{'re'};
454        my $extrakeys_md  = $ek->{'md'};
455        my $extrakeys_mf  = $ek->{'mf'};
456        &extrametautil::addmetakey(\@extrametakeys, $extrakeys_re);
457        &extrametautil::setmetadata(\%extrametadata, $extrakeys_re, $extrakeys_md);
458        &extrametautil::setmetafile(\%extrametafile, $extrakeys_re, $extrakeys_mf);
459        }
460        delete($self->{'subdir_extrametakeys'}->{$local_dirname});
461    }
462    }
463    # apply metadata pass for each of the files in the directory -- ignore
464    # maxdocs here
465    my $num_files = scalar(@dir);
466    for (my $i = 0; $i < scalar(@dir); $i++) {
467    my $subfile = $dir[$i];
468    next if ($subfile =~ m/^\.\.?$/);
469
470    my $this_file_base_dir = $base_dir;
471    my $raw_subfile = &unicode::url_encoded_to_raw_filename($subfile);
472
473    my $raw_file_subfile = &FileUtils::filenameConcatenate($file, $raw_subfile);
474    my $raw_full_filename = &FileUtils::filenameConcatenate($this_file_base_dir, $raw_file_subfile);
475
476    if ($self->file_is_blocked($block_hash,$raw_full_filename)) {
477        print STDERR "DirectoryPlugin: file $raw_full_filename was blocked for metadata_read\n" if ($verbosity > 2);
478        next;
479    }
480   
481    # Recursively read each $raw_subfile
482    print $outhandle "DirectoryPlugin metadata recurring: $raw_subfile\n" if ($verbosity > 2);
483   
484    &plugin::metadata_read ($pluginfo, $this_file_base_dir,
485                $raw_file_subfile,$block_hash,
486                \@extrametakeys, \%extrametadata,
487                \%extrametafile,
488                $processor, $gli);
489    $additionalmetadata = 1;
490    }
491
492    # filter out any extrametakeys that mention subdirectories and store
493    # for later use (i.e. when that sub-directory is being processed)
494    foreach my $ek (@extrametakeys) { # where each Extrametakey (which is a filename) is stored as a  url-style regex
495   
496    my ($subdir_re,$extrakey_dir) = &util::url_fileparse($ek);
497   
498    if ($extrakey_dir ne "") {
499        # a subdir was specified
500        my $md = &extrametautil::getmetadata(\%extrametadata, $ek);
501        my $mf = &extrametautil::getmetafile(\%extrametafile, $ek);
502
503        my $subdir_extrametakeys = $self->{'subdir_extrametakeys'};
504        my $subdir_rec = { 're' => $subdir_re, 'md' => $md, 'mf' => $mf };
505
506        # when it's looked up, it must be relative to the base dir
507        push(@{$subdir_extrametakeys->{"$local_dirname$extrakey_dir"}},$subdir_rec);
508    }
509    }
510   
511    # import each of the files in the directory
512    my $count=0;
513    for (my $i = 0; $i <= scalar(@dir); $i++) {
514    # When every file in the directory has been done, pause for a moment (figuratively!)
515    # If the -recheck_directories argument hasn't been provided, stop now (default)
516    # Otherwise, re-read the contents of the directory to check for new files
517    #   Any new files are added to the @dir list and are processed as normal
518    #   This is necessary when documents to be indexed are specified in bibliographic DBs
519    #   These files are copied/downloaded and stored in a new folder at import time
520    if ($i == $num_files) {
521        last unless $self->{'recheck_directories'};
522
523        # Re-read the files in the directory to see if there are any new files
524        last if (!opendir (DIR, $dirname));
525        my @dirnow = sort readdir (DIR);
526        map { $_ = &unicode::raw_filename_to_url_encoded($_) } @dirnow;
527        closedir (DIR);
528
529        # We're only interested if there are more files than there were before
530        last if (scalar(@dirnow) <= scalar(@dir));
531
532        # Any new files are added to the end of @dir to get processed by the loop
533        my $j;
534        foreach my $subfilenow (@dirnow) {
535        for ($j = 0; $j < $num_files; $j++) {
536            last if ($subfilenow eq $dir[$j]);
537        }
538        if ($j == $num_files) {
539            # New file
540            push(@dir, $subfilenow);
541        }
542        }
543        # When the new files have been processed, check again
544        $num_files = scalar(@dir);
545    }
546
547    my $subfile = $dir[$i];
548    last if ($maxdocs != -1 && ($count + $total_count) >= $maxdocs);
549    next if ($subfile =~ /^\.\.?$/);
550     print STDERR "poo poo poo\n";
551    my $this_file_base_dir = $base_dir;
552    my $raw_subfile = &unicode::url_encoded_to_raw_filename($subfile);
553    my $unicode_subfile = &util::raw_filename_to_unicode($dirname, $raw_subfile);
554    print STDERR "raw = $raw_subfile, unicode = $unicode_subfile\n";
555
556    my $raw_file_subfile = &FileUtils::filenameConcatenate($file, $raw_subfile);
557    my $raw_full_filename
558        = &FileUtils::filenameConcatenate($this_file_base_dir,$raw_file_subfile);
559
560    if ($self->file_is_blocked($block_hash,$raw_full_filename)) {
561        print STDERR "DirectoryPlugin: file $raw_full_filename was blocked for read\n" if ($verbosity > 2);
562        next;
563    }
564    print STDERR "** Dir Plugin processing $raw_full_filename\n";
565    # Follow Windows shortcuts
566    if ($raw_subfile =~ m/(?i)\.lnk$/ && (($ENV{'GSDLOS'} =~ m/^windows$/i) && ($^O ne "cygwin"))) {
567        require Win32::Shortcut;
568        my $shortcut = new Win32::Shortcut(&FileUtils::filenameConcatenate($dirname, $raw_subfile));
569        if ($shortcut) {
570        # The file to be processed is now the target of the shortcut
571        $this_file_base_dir = "";
572        $file = "";
573        $raw_subfile = $shortcut->Path;
574        }
575    }
576
577    # check for a symlink pointing back to a leading directory
578    if (-d "$dirname/$raw_subfile" && -l "$dirname/$raw_subfile") {
579        # readlink gives a "fatal error" on systems that don't implement
580        # symlinks. This assumes the the -l test above would fail on those.
581        my $linkdest=readlink "$dirname/$raw_subfile";
582        if (!defined ($linkdest)) {
583        # system error - file not found?
584        warn "DirectoryPlugin: symlink problem - $!";
585        } else {
586        # see if link points to current or a parent directory
587        if ($linkdest =~ m@^[\./\\]+$@ ||
588            index($dirname, $linkdest) != -1) {
589            warn "DirectoryPlugin: Ignoring recursive symlink ($dirname/$raw_subfile -> $linkdest)\n";
590            next;
591            ;
592        }
593        }
594    }
595
596    print $outhandle "DirectoryPlugin: preparing metadata for $raw_subfile\n" if ($verbosity > 2);
597
598    # Make a copy of $in_metadata to pass to $raw_subfile
599    my $out_metadata = {};
600    &metadatautil::combine_metadata_structures($out_metadata, $in_metadata);
601
602    # check the assocfile_info
603    if (defined $self->{'assocfile_info'}->{$raw_full_filename}) {
604        &metadatautil::combine_metadata_structures($out_metadata, $self->{'assocfile_info'}->{$raw_full_filename});
605    }
606
607    ### $subfile by this point is url-encoded => all ASCII chars => no need to encode as UTF8
608       print STDERR "****** subfile = $subfile, raw_subfile = $raw_subfile\n";
609    print STDERR &unicode::debug_unicode_string("subfile = $subfile, raw_subfile = $raw_subfile\n");
610    print STDERR "looking up unicode version $unicode_subfile (". &unicode::debug_unicode_string($unicode_subfile).") \n";
611    # instead of using the subfile, we need unicode aware string
612    ###my $lookup_name = decode("utf8", $raw_subfile);
613    ####print STDERR "lookup nmae = $lookup_name ( \n";
614    # Next add metadata read in XML files (if it is supplied)
615    if ($additionalmetadata == 1) {
616        foreach my $filespec (@extrametakeys) {
617        ## use the url-encoded filename to do the filename comparison
618        print STDERR "### comparing against filespec $filespec (";
619        print STDERR &unicode::debug_unicode_string("$filespec");
620        print STDERR ")\n";
621        if ($unicode_subfile =~ /^$filespec$/) {
622        ###if ($lookup_name =~ /^$filespec$/) {
623            print $outhandle "^^^^^^^^^File \"$unicode_subfile\" matches filespec \"$filespec\"\n"
624            if ($verbosity > 2);
625            my $mdref = &extrametautil::getmetadata(\%extrametadata, $filespec);
626            my $mfref = &extrametautil::getmetafile(\%extrametafile, $filespec);
627
628            # Add the list files where the metadata came from
629            # into the metadata table so we can track this
630            # This mechanism is similar to how gsdlassocfile works
631
632            my @metafile_pair = ();
633            foreach my $l (keys %$mfref) {
634            my $f = $mfref->{$l};
635            push (@metafile_pair, "$f : $l");
636            }
637
638            $mdref->{'gsdlmetafile'} = \@metafile_pair;
639
640            &metadatautil::combine_metadata_structures($out_metadata, $mdref);
641        }
642        }
643    }
644
645    if (defined $self->{'inf_timestamp'}) {
646        # Look to see if it's a completely new file
647
648        if (!$block_hash->{'new_files'}->{$raw_full_filename}) {
649        # Not a new file, must be an existing file
650        # Let' see if it's newer than the last import.pl
651
652
653        if (! -d $raw_full_filename) {
654            if (!$block_hash->{'reindex_files'}->{$raw_full_filename}) {
655            # filename has been around for longer than inf_timestamp
656            print $outhandle "**** Skipping $unicode_subfile\n" if ($verbosity >3);
657            next;
658            }
659            else {
660            # Remove old folder in archives (might hash to something different)
661            # *** should be doing this on a Del one as well
662            # but leave folder name?? and ensure hashs to
663            # same again??
664
665            # Then let through as new doc??
666
667            # mark to doc-oids that rely on it for re-indexing
668            }
669        }
670        }
671    }
672
673    # Recursively read each $subfile
674    print $outhandle "DirectoryPlugin recurring: $unicode_subfile\n" if ($verbosity > 2);
675   
676    $count += &plugin::read ($pluginfo, $this_file_base_dir,
677                 $raw_file_subfile, $block_hash,
678                 $out_metadata, $processor, $maxdocs, ($total_count + $count), $gli);
679    }
680
681    return $count;
682}
683
684sub compile_stats {
685    my $self = shift(@_);
686    my ($stats) = @_;
687}
688
6891;
Note: See TracBrowser for help on using the browser.