Changeset 18441 for gsdl/trunk
- Timestamp:
- 2009-02-01T14:36:22+13:00 (15 years ago)
- Location:
- gsdl/trunk/perllib
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
gsdl/trunk/perllib/arcinfo.pm
r15889 r18441 42 42 use strict; 43 43 44 use dbutil; 44 45 45 46 # File format read in: OID <tab> Filename <tab> Optional-Index-Status … … 60 61 } 61 62 62 sub load_info { 63 my $self = shift (@_); 64 my ($filename) = @_; 65 66 $self->{'info'} = {}; 67 63 sub _load_info_txt 64 { 65 my $self = shift (@_); 66 my ($filename) = @_; 67 68 68 if (defined $filename && -e $filename) { 69 69 open (INFILE, $filename) || … … 80 80 close (INFILE); 81 81 } 82 } 83 84 sub save_info { 82 83 84 } 85 86 sub _load_info_gdbm 87 { 88 my $self = shift (@_); 89 my ($filename) = @_; 90 91 my $infodb_map = {}; 92 93 &dbutil::read_infodb_file_gdbm($filename,$infodb_map); 94 95 foreach my $oid ( keys %$infodb_map ) { 96 my $vals = $infodb_map->{$oid}; 97 # interested in doc-file and index-status 98 99 my ($doc_file) = ($vals=~/^<doc-file>(.*)$/m); 100 my ($index_status) = ($vals=~/^<index-status>(.*)$/m); 101 $self->add_info ($oid,$doc_file,$index_status); 102 } 103 } 104 105 sub load_info { 106 my $self = shift (@_); 107 my ($filename) = @_; 108 109 $self->{'info'} = {}; 110 111 if ((defined $filename) && (-e $filename)) { 112 if ($filename =~ m/\.inf$/) { 113 $self->_load_info_txt($filename); 114 } 115 else { 116 $self->_load_info_gdbm($filename); 117 } 118 } 119 } 120 121 sub _load_filelist_gdbm 122 { 123 my $self = shift (@_); 124 my ($filename) = @_; 125 126 my $infodb_map = {}; 127 128 &dbutil::read_infodb_keys_gdbm($filename,$infodb_map); 129 130 foreach my $file ( keys %$infodb_map ) { 131 $self->{'import_filelist'}->{$file} = 1; 132 } 133 } 134 135 136 sub load_import_filelist { 137 my $self = shift (@_); 138 my ($filename) = @_; 139 140 $self->{'import-filelist'} = {}; 141 142 if ((defined $filename) && (-e $filename)) { 143 if ($filename =~ m/\.inf$/) { 144 # e.g. 'archives-src.inf' (which includes complete list of file 145 # from last time import.pl was run) 146 $self->_load_info_txt($filename); 147 } 148 else { 149 $self->_load_filelist_gdbm($filename); 150 } 151 } 152 } 153 154 sub _save_info_txt { 85 155 my $self = shift (@_); 86 156 my ($filename) = @_; … … 97 167 } 98 168 close (OUTFILE); 169 } 170 171 sub _save_info_gdbm { 172 my $self = shift (@_); 173 my ($filename) = @_; 174 175 # Not the most efficient operation, but will do for now 176 177 # read it in 178 my $infodb_map = {}; 179 &dbutil::read_infodb_file_gdbm($filename,$infodb_map); 180 181 # change index-status values 182 foreach my $info (@{$self->get_OID_list()}) { 183 if (defined $info) { 184 my ($oid,$doc_file,$index_status) = @$info; 185 if (defined $infodb_map->{$oid}) { 186 my $vals_ref = \$infodb_map->{$oid}; 187 $$vals_ref =~ s/^<index-status>(.*)$/<index-status>$index_status/m; 188 } 189 else { 190 print STDERR "Warning: $filename does not have key $oid\n"; 191 } 192 } 193 } 194 195 196 # write out again 197 my $infodb_handle = &dbutil::open_infodb_write_handle_gdbm($filename); 198 foreach my $oid ( keys %$infodb_map ) { 199 # consider making the following a method in dbutil 200 # e.g. write_infodb_rawentry_gdbm($infodb_handle,$oid,$vals); 201 202 # no need to escape, as $infodb_map->{$oid} hasn't been unescaped 203 print $infodb_handle "[$oid]\n"; 204 print $infodb_handle $infodb_map->{$oid}; 205 print $infodb_handle '-' x 70, "\n"; 206 } 207 &dbutil::close_infodb_write_handle_gdbm($infodb_handle); 208 209 } 210 211 sub save_info { 212 my $self = shift (@_); 213 my ($filename) = @_; 214 215 if ($filename =~ m/\.inf$/) { 216 $self->_save_info_txt($filename); 217 } 218 else { 219 $self->_save_info_gdbm($filename); 220 } 99 221 } 100 222 -
gsdl/trunk/perllib/basebuilder.pm
r17573 r18441 470 470 $build_cfg->{'numsections'} = $self->{'buildproc'}->get_num_sections(); 471 471 $build_cfg->{'numbytes'} = $self->{'buildproc'}->get_num_bytes(); 472 472 473 473 # store the mapping between the index names and the directory names 474 474 # the index map is used to determine what indexes there are, so any that are not built should not be put into the map. -
gsdl/trunk/perllib/cfgread.pm
r16929 r18441 141 141 my ($filename, $data, $stringexp, $arrayexp, $hashexp, $arrayarrayexp, 142 142 $hashhashexp) = @_; 143 143 144 144 if (open (COLCFG, ">$filename")) { 145 145 foreach my $key (sort(keys(%$data))) { -
gsdl/trunk/perllib/cpan/Image/Size.pm
r13983 r18441 18 18 package Image::Size; 19 19 20 require 5.6.0; 20 # require 5.6.0; 21 require 5.006_000; 21 22 22 23 use strict; -
gsdl/trunk/perllib/dbutil.pm
r17476 r18441 320 320 my $infodb_map = shift(@_); 321 321 322 open (PIPEIN, "db2txt \"$infodb_file_path\" |") || die "couldn't open pipe from db2txt \n";322 open (PIPEIN, "db2txt \"$infodb_file_path\" |") || die "couldn't open pipe from db2txt \$infodb_file_path\"\n"; 323 323 my $infodb_line = ""; 324 324 my $infodb_key = ""; … … 340 340 $infodb_value .= $infodb_line; 341 341 } 342 } 343 344 close (PIPEIN); 345 } 346 347 sub read_infodb_keys_gdbm 348 { 349 my $infodb_file_path = shift(@_); 350 my $infodb_map = shift(@_); 351 352 open (PIPEIN, "gdbmkeys \"$infodb_file_path\" |") || die "couldn't open pipe from gdbmkeys \$infodb_file_path\"\n"; 353 my $infodb_line = ""; 354 my $infodb_key = ""; 355 my $infodb_value = ""; 356 while (defined ($infodb_line = <PIPEIN>)) 357 { 358 chomp $infodb_line; # remove end of line 359 360 $infodb_map->{$infodb_line} = 1; 342 361 } 343 362 -
gsdl/trunk/perllib/manifest.pm
r17249 r18441 1 1 package manifest; 2 3 2 4 3 use XMLParser; 5 4 use strict; 6 5 no strict 'refs'; # allow filehandles to be variables and viceversa 7 8 6 9 7 our $self; -
gsdl/trunk/perllib/plugin.pm
r17746 r18441 301 301 die "\n"; 302 302 } 303 303 304 304 my $had_error = 0; 305 305 # pass this file by each of the plugins in turn until one -
gsdl/trunk/perllib/plugins/ArchivesInfPlugin.pm
r17738 r18441 24 24 ########################################################################### 25 25 26 # plugin which reads through an archives.inf file 27 # (i.e. the file generated in the archives directory 28 # when an import is done), processing each file it finds 26 # plugin which reads through an archives.inf (or GDBM equivalent, 27 # archiveinf-doc.{ldb,bdb} file (i.e. the file generated in the 28 # archives directory when an import is done), processing each file it 29 # finds 29 30 30 31 package ArchivesInfPlugin; … … 86 87 my ($self) = @_; 87 88 89 print STDERR "*** Running ArchivesInf deinit\n"; 90 88 91 my $archive_info = $self->{'archive_info'}; 89 92 … … 93 96 my $file_list = $archive_info->get_file_list(); 94 97 95 # change each file to "Been Indexed"96 97 98 foreach my $subfile (@$file_list) { 98 99 my $doc_oid = $subfile->[1]; 99 # why do we get this when it is not used??? 100 100 101 my $index_status = $archive_info->get_status_info($doc_oid); 101 $archive_info->set_status_info($doc_oid,"B"); 102 if ($index_status eq "D") { 103 # delete 104 $archive_info->delete_info($doc_oid); 105 } 106 elsif ($index_status =~ m/^(I|R)$/) { 107 # mark as "been indexed" 108 $archive_info->set_status_info($doc_oid,"B"); 109 } 102 110 } 103 111 … … 169 177 170 178 # see if this has a archives information file within it 171 my $archive_info_filename = &util::filename_cat($base_dir,$file,"archives.inf"); 179 ## my $archive_info_filename = &util::filename_cat($base_dir,$file,"archives.inf"); 180 my $db_ext = &util::is_little_endian() ? ".ldb" : ".bdb"; 181 my $doc_db = "archiveinf-doc$db_ext"; 182 my $archive_info_filename = &util::filename_cat($base_dir,$file,$doc_db); 172 183 173 184 if (-e $archive_info_filename) { … … 187 198 # process each file 188 199 foreach my $subfile (@$file_list) { 200 189 201 last if ($maxdocs != -1 && ($total_count + $count) >= $maxdocs); 190 202 … … 198 210 if ($processor->is_incremental_capable() && $self->{'incremental'}) 199 211 { 200 # We don't need to process the file if it has already been built212 # Check to see if the file needs indexing 201 213 my $doc_oid = $subfile->[1]; 202 214 my $index_status = $archive_info->get_status_info($doc_oid); 203 215 if ($index_status eq "B") 204 216 { 205 # Don't process this file 217 # Don't process this file as it has already been indexed 206 218 $process_file = 0; 207 219 } -
gsdl/trunk/perllib/plugins/BasePlugin.pm
r18404 r18441 433 433 my ($filename_full_path, $filename_no_path) = &util::get_full_filenames($base_dir, $file); 434 434 435 if (!-d $filename_full_path) { 436 $block_hash->{'all_files'}->{$file} = 1; 437 } 438 435 439 my $associate_tail_re = $self->{'associate_tail_re'}; 436 440 if ((defined $associate_tail_re) && ($associate_tail_re ne "")) { -
gsdl/trunk/perllib/plugins/DirectoryPlugin.pm
r17738 r18441 131 131 132 132 my $output_dir = $processor->getoutputdir(); 133 my $archives_inf = &util::filename_cat($output_dir,"archives.inf"); 134 133 ## my $archives_inf = &util::filename_cat($output_dir,"archives.inf"); 134 my $db_ext = &util::is_little_endian() ? ".ldb" : ".bdb"; 135 my $doc_db = "archiveinf-doc$db_ext"; 136 my $archives_inf = &util::filename_cat($output_dir,$doc_db); 137 135 138 if ( -e $archives_inf ) { 136 139 $self->{'inf_timestamp'} = -M $archives_inf; … … 278 281 return $directory_ok unless (defined $directory_ok && $directory_ok == 1); 279 282 283 $block_hash->{'all_files'} = {} unless defined $block_hash->{'all_files'}; 284 280 285 $block_hash->{'file_blocks'} = {} unless defined $block_hash->{'file_blocks'}; 281 286 $block_hash->{'shared_fileroot'} = {} unless defined $block_hash->{'shared_fileroot'}; … … 576 581 if ($filename_timestamp > $inf_timestamp) { 577 582 # filename has been around for longer than inf 578 ##### print $outhandle "**** Skipping $subfile\n";583 print $outhandle "**** Skipping $subfile\n" if ($verbosity >3); 579 584 next; 580 585 } -
gsdl/trunk/perllib/plugouts/BasePlugout.pm
r17884 r18441 404 404 ############################## 405 405 $self->saveas($doc_obj,$doc_dir); 406 ##$self->archiveinf_gdbm($doc_obj,$doc_dir);406 $self->archiveinf_gdbm($doc_obj,$doc_dir); 407 407 408 408 } … … 660 660 my $source_filename = $doc_obj->get_source_filename(); 661 661 662 my $oid_files = { 'src-file' => $source_filename, 662 my $working_info = $self->{'output_info'}; 663 my $doc_info = $working_info->get_info($oid); 664 my ($doc_file,$index_status) = @$doc_info; 665 666 my $oid_files = { 'doc-file' => $doc_file, 667 'index-status' => $index_status, 668 'src-file' => $source_filename, 663 669 'assoc-files' => [] }; 664 670 … … 701 707 702 708 my $doc_db_text = ""; 709 $doc_db_text .= "<doc-file>$oid_files->{'doc-file'}\n"; 710 $doc_db_text .= "<index-status>$oid_files->{'index-status'}\n"; 703 711 $doc_db_text .= "<src-file>$oid_files->{'src-file'}\n"; 704 712 foreach my $af (@{$oid_files->{'assoc-files'}}) { -
gsdl/trunk/perllib/util.pm
r18411 r18441 768 768 } 769 769 770 sub filename_is_absolute 771 { 772 my ($filename) = @_; 773 774 if ($ENV{'GSDLOS'} =~ /^windows$/i) { 775 return ($filename =~ m/^(\w:)?\\/); 776 } 777 else { 778 return ($filename =~ m/^\//); 779 } 780 } 781 782 770 783 ## @method make_absolute() 771 784 # … … 786 799 787 800 my ($base_dir, $dir) = @_; 788 print STDERR "dir = $dir\n";801 ### print STDERR "dir = $dir\n"; 789 802 $dir =~ s/[\\\/]+/\//g; 790 803 $dir = $base_dir . "/$dir" unless ($dir =~ m|^(\w:)?/|); … … 793 806 $dir =~ s|/[.][.]?/|/|g; 794 807 $dir =~ tr|/|/|s; 795 print STDERR "dir = $dir\n";808 ### print STDERR "dir = $dir\n"; 796 809 797 810 return $dir;
Note:
See TracChangeset
for help on using the changeset viewer.