Changeset 30338
- Timestamp:
- 2015-12-03T15:44:18+13:00 (8 years ago)
- Location:
- gs2-extensions/tdb/trunk/perllib/DBDrivers
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
gs2-extensions/tdb/trunk/perllib/DBDrivers/JDBM.pm
r30318 r30338 32 32 use util; 33 33 use FileUtils; 34 use DBDrivers::BaseDBDriver; 34 # - OO inheritence 35 use parent 'DBDrivers::BaseDBDriver'; 35 36 36 37 sub BEGIN 37 38 { 38 @DBDrivers::JDBM::ISA = ( 'DBDrivers::BaseDBDriver' ); 39 } 40 39 if (!defined $ENV{'GSDLHOME'} || !defined $ENV{'GSDLOS'}) { 40 die("Error! Environment must be prepared by sourcing setup.bash\n"); 41 } 42 } 43 44 45 ## @function constructor 46 # 41 47 sub new 42 48 { 43 49 my $class = shift(@_); 44 return bless ($self, $class); 45 } 50 my $self = DBDrivers::BaseDBDriver->new(); 51 $self->{'default_file_extension'} = 'jdb'; 52 bless($self, $class); 53 return $self; 54 } 55 ## constructor() ## 56 46 57 47 58 # ----------------------------------------------------------------------------- … … 54 65 # be constructed that changes between much of the code that is used 55 66 67 # Handled by BaseDBDriver 68 # sub get_infodb_file_path {} 69 70 71 56 72 sub open_infodb_write_handle 57 73 { 58 my $infodb_file_path = shift(@_); 59 my $opt_append = shift(@_); 60 61 my $jdbmwrap_jar = &util::filename_cat($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar"); 62 my $jdbm_jar = &util::filename_cat($ENV{'GSDLHOME'},"lib","java", "jdbm.jar"); 74 my $self = shift(@_); 75 my $infodb_file_path = shift(@_); 76 my $opt_append = shift(@_); 77 if (!defined $opt_append) { 78 $opt_append = ''; 79 } 80 $self->_debugPrint('("' . $infodb_file_path . '","' . $opt_append . '")'); 81 82 my $jdbmwrap_jar = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"bin","java", "JDBMWrapper.jar"); 83 my $jdbm_jar = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"lib","java", "jdbm.jar"); 63 84 64 85 my $classpath = &util::pathname_cat($jdbmwrap_jar,$jdbm_jar); … … 76 97 my $txt2jdb_cmd = "java -cp \"$classpath\" Txt2Jdb"; 77 98 78 if ( (defined $opt_append) && ($opt_append eq "append")) {99 if ($opt_append eq "append") { 79 100 $txt2jdb_cmd .= " -append"; 80 101 print STDERR "Append operation to $infodb_file_path\n"; … … 113 134 114 135 close($infodb_handle); 115 }116 117 118 sub get_infodb_file_path119 {120 my $collection_name = shift(@_);121 my $infodb_directory_path = shift(@_);122 123 my $infodb_file_extension = ".jdb";124 my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;125 return &util::filename_cat($infodb_directory_path, $infodb_file_name);126 136 } 127 137 -
gs2-extensions/tdb/trunk/perllib/DBDrivers/TDB.pm
r30318 r30338 32 32 # Libraries 33 33 use Cwd; 34 use Devel::Peek; 34 35 use ghtml; 36 use Scalar::Util 'refaddr'; 35 37 use util; 36 use DBDrivers::GDBM; 38 # - OO inheritence 39 use parent 'DBDrivers::GDBM'; 37 40 38 41 sub BEGIN … … 44 47 die("Error! Path to TDB binaries not found. Have you sourced setup.bash?\n"); 45 48 } 46 @DBDrivers::TDB::ISA = ( 'DBDrivers::GDBM' );47 49 } 48 50 … … 50 52 { 51 53 my $class = shift(@_); 52 return bless ($self, $class); 53 } 54 55 my $self = DBDrivers::GDBM->new(); 56 57 # Default TDB file extension 58 $self->{'default_file_extension'} = 'tdb'; 59 # Should the TDB used a specific affinity? 60 $self->{'forced_affinity'} = -1; # zero upwards indicates the affinity 61 # Keep track of all opened file handles 62 $self->{'handle_pool'} = {}; 63 # Ask TDB executables to display debugging information? 64 $self->{'tdb_debug'} = 0; # 1 to enable 65 66 bless($self, $class); 67 return $self; 68 } 69 70 71 ## @function DESTROY 72 # 73 # Built-in destructor block that, unlike END, gets passed a reference to self. 74 # Responsible for properly closing any open database handles. 75 # 76 sub DESTROY 77 { 78 my $self = shift(@_); 79 # Close all remaining filehandles 80 foreach my $infodb_file_path (keys(%{$self->{'handle_pool'}})) { 81 my $infodb_handle = $self->{'handle_pool'}->{$infodb_file_path}; 82 # By passing the filepath as the second argument we instruct the driver 83 # that we actually want to close the connection by passing a non-zero 84 # value, but we sneakily optimize things a little as the close method 85 # can now check to see if it's been provided a file_path rather than 86 # having to search the handle pool for it. The file_path is needed to 87 # remove the closed handle from the pool anyway. 88 $self->close_infodb_write_handle($infodb_handle, $infodb_file_path); 89 } 90 } 91 ## DESTROY(void) => void ## 92 54 93 55 94 # ----------------------------------------------------------------------------- … … 57 96 # ----------------------------------------------------------------------------- 58 97 59 ## Ask TDB executables to display debugging information?60 my $debug = 0; # 1 to enable61 62 ## Should the TDB used a specific affinity?63 my $forced_affinity = -1; # zero upwards indicates the affinity64 65 ## Default TDB file extension66 my $infodb_file_extension = '.tdb';67 98 68 99 ## @function _get_tdb_executable(string) … … 70 101 sub _get_tdb_executable 71 102 { 103 my $self = shift(@_); 72 104 my $program = shift(@_); 73 105 if (!defined $ENV{GEXTTDBEDIT_INSTALLED} || !-d $ENV{GEXTTDBEDIT_INSTALLED}) … … 82 114 return $program_exe; 83 115 } 84 ## get_tdb_executable(string) => string ## 85 116 ## _get_tdb_executable(string) => string ## 117 118 119 # Handled by BaseDBDriver 120 # sub get_infodb_file_path(string, string) 86 121 87 122 # With infodb_handle already set up, these functions work the same as parent version 88 # sub close_infodb_write_handle {}89 123 # sub delete_infodb_entry {} 90 124 # sub write_infodb_entry {} … … 92 126 93 127 128 ## @function close_infodb_write_handle(filehandle) 129 # 130 # Some slight-of-hand here due to the way Perl passes variables to methods. 131 # Most of the time (i.e. under all the existing calls in the Greenstone code) 132 # this does nothing, as TDB handles can be left open and reused by multiple 133 # writers/readers (the exception being complete file reads, but they are 134 # handled in their own function anyway). 135 # 136 # However TDB's version of this function will look for an extra variable and, 137 # if true (non-zero), will actually close the handle. Several methods below 138 # call close but also pass the infodb_file_path as the second argument, which 139 # is enough to have the connections properly closed. 140 # 141 # Note that when this class passes from scope all open handles will be 142 # properly closed by the DESTROY block. 143 # 144 sub close_infodb_write_handle { 145 my $self = shift(@_); 146 my $infodb_handle = shift(@_); 147 my $actually_close = shift(@_); # Undefined most of the time 148 if (defined($actually_close)) { 149 $self->_debugPrint('(<infodb_handle>,"' . $actually_close . '")'); 150 # We'll need the file path so we can locate and remove the entry in the 151 # handle pool 152 my $infodb_file_path = undef; 153 # Sometimes we can cheat, as the actually_close variable will have the 154 # file_path in it thanks to the DESTROY block above. Doing a regex on 155 # actually_close will treat it like a string no matter what it was, and 156 # we can search for the appropriate file extension that should be there 157 # for valid paths. 158 my $pattern = '\.' . $self->{'default_file_extension'} . '$'; 159 if ($actually_close =~ /$pattern/) { 160 $infodb_file_path = $actually_close; 161 } 162 # If we can't cheat then we are stuck finding which connection in the 163 # handle_pool we are about to close. Need to compare objects using 164 # refaddr() 165 else { 166 foreach my $possible_file_path (values(%{$self->{'handle_pool'}})) { 167 my $possible_handle = $self->{'handle_pool'}->{$possible_file_path}; 168 if (ref($infodb_handle) && ref($possible_handle) && refaddr($infodb_handle) == refaddr($possible_handle)) { 169 $infodb_file_path = $possible_file_path; 170 last; 171 } 172 } 173 } 174 if (defined($infodb_file_path)) { 175 delete($self->{'handle_pool'}->{$infodb_file_path}); 176 } 177 else { 178 print STDERR "Warning! About to close TDB database handle, but couldn't locate in open handle pool.\n"; 179 } 180 # Call GDBM's close to do the heavy-lifting 181 $self->SUPER::close_infodb_write_handle($infodb_handle); 182 } 183 } 184 ## close_infodb_write_handle(filehandle) => void ## 185 186 94 187 ## @function open_infodb_write_handle(string, string) 95 188 # 96 189 sub open_infodb_write_handle 97 190 { 191 my $self = shift(@_); 98 192 my $infodb_file_path = shift(@_); 99 193 my $opt_append = shift(@_); 100 194 101 my $txt2tdb_exe = &_get_tdb_executable('txt2tdb'); 102 103 my $pool_key = $infodb_file_path; 195 my $txt2tdb_exe = $self->_get_tdb_executable('txt2tdb'); 196 104 197 my $cmd = '"' . $txt2tdb_exe . '"'; 105 198 if ((defined $opt_append) && ($opt_append eq "append")) { … … 108 201 $cmd .= ' "' . $infodb_file_path . '"'; 109 202 # Optional flags 110 if ($ forced_affinity>= 0) {203 if ($self->{'forced_affinity'} >= 0) { 111 204 $cmd = 'taskset -c 5 ' . $cmd; 112 205 } 113 if ($ debug) {206 if ($self->{'debug'}) { 114 207 $cmd .= ' -debug'; 115 208 } … … 118 211 # within the buildproc, so we create a piped handle here 119 212 my $infodb_file_handle = undef; 120 print STDERR "tdb::open_infodb_write_handle(" . $infodb_file_path . ")\n"; 121 if(!open($infodb_file_handle, "| $cmd")) { 122 print STDERR "Error: Failed to open pipe to $cmd\n"; 123 print STDERR " $!\n"; 124 return undef; 125 } 126 binmode($infodb_file_handle,":utf8"); 213 # if the connection is already open, simply return it. 214 if (defined $self->{'handle_pool'}->{$infodb_file_path}) { 215 $infodb_file_handle = $self->{'handle_pool'}->{$infodb_file_path}; 216 } 217 else { 218 $self->_debugPrint('(' . $infodb_file_path . ')'); 219 if(!open($infodb_file_handle, "| $cmd")) { 220 print STDERR "Error: Failed to open pipe to $cmd\n"; 221 print STDERR " $!\n"; 222 return undef; 223 } 224 binmode($infodb_file_handle,":utf8"); 225 # Remember to store the newly created connection in the pool so we can 226 # re-use for subsequent calls. 227 $self->{'handle_pool'}->{$infodb_file_path} = $infodb_file_handle; 228 } 127 229 return $infodb_file_handle; 128 230 } … … 130 232 131 233 132 ## @function get_infodb_file_path(string, string)133 #134 sub get_infodb_file_path135 {136 my $collection_name = shift(@_);137 my $infodb_directory_path = shift(@_);138 my $infodb_file_name = &util::get_dirsep_tail($collection_name) . $infodb_file_extension;139 return &util::filename_cat($infodb_directory_path, $infodb_file_name);140 }141 ## get_infodb_file_path(string, string) => string ##142 143 144 234 ## @function read_infodb_file 145 235 # 146 236 sub read_infodb_file 147 237 { 238 my $self = shift(@_); 148 239 my $infodb_file_path = shift(@_); 149 240 my $infodb_map = shift(@_); 150 241 151 my $tdb2txt_exe = &_get_tdb_executable('tdb2txt'); 242 $self->_debugPrint('(' . $infodb_file_path . ', <hashmap>)'); 243 244 my $tdb2txt_exe = $self->_get_tdb_executable('tdb2txt'); 152 245 153 246 if (!open (PIPEIN, '"' . $tdb2txt_exe . '" "' . $infodb_file_path . '" |')) { … … 184 277 sub read_infodb_keys 185 278 { 279 my $self = shift(@_); 186 280 my $infodb_file_path = shift(@_); 187 281 my $infodb_map = shift(@_); 188 282 189 my $tdbkeys_exe = &_get_tdb_executable('tdbkeys'); 190 191 if (!open (PIPEIN, '"' . tdbkeys_exe . '" "' . $infodb_file_path . '" |')) { 283 $self->_debugPrint('(' . $infodb_file_path . ', <hashmap>)'); 284 285 my $tdbkeys_exe = $self->_get_tdb_executable('tdbkeys'); 286 287 if (!open (PIPEIN, '"' . $tdbkeys_exe . '" "' . $infodb_file_path . '" |')) { 192 288 die("Error! Couldn't open pipe from read_infodb_keys: $infodb_file_path\n$!\n"); 193 289 } … … 213 309 sub set_infodb_entry 214 310 { 311 my $self = shift(@_); 215 312 my $infodb_file_path = shift(@_); 216 313 my $infodb_key = shift(@_); 217 314 my $infodb_map = shift(@_); 315 316 $self->_debugPrint('(' . $infodb_file_path . ', ' . $infodb_key . ', <hashmap>)'); 218 317 219 318 # Protect metadata values that go inside quotes for tdbset … … 236 335 237 336 # Generate the record string 238 my $serialized_infodb_map = &_convert_infodb_hash_to_string($infodb_map);337 my $serialized_infodb_map = $self->_convert_infodb_hash_to_string($infodb_map); 239 338 240 339 # Store it into GDBM 241 my $tdbset_exe = &_get_tdb_executable('tdbset');340 my $tdbset_exe = $self->_get_tdb_executable('tdbset'); 242 341 my $cmd = '"' . $tdbset_exe . '" "' . $infodb_file_path . '" "' . $infodb_key . '" "' . $serialized_infodb_map . '"'; 243 342 my $status = system($cmd);
Note:
See TracChangeset
for help on using the changeset viewer.