source: main/trunk/greenstone2/perllib/util.pm@ 27970

Last change on this file since 27970 was 27970, checked in by ak19, 11 years ago

Fix to regex. The regex sorting the ordering of the generated paged_img files needed to be corrected: the extra question mark makes the match less greedy. Before, the .* would match all the characters up to but exluding the last digitbefore the file extension. Instead, we want it to match all the chars up to but excluding the first digit (in a sequence of consecutive digits) before the file extension.
  • Property svn:keywords set to Author Date Id Revision
File size: 40.6 KB
Line 
1###########################################################################
2#
3# util.pm -- various useful utilities
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
26package util;
27
28use strict;
29use FileUtils;
30
31use Encode;
32use File::Copy;
33use File::Basename;
34# Config for getting the perlpath in the recommended way, though it uses paths that are
35# hard-coded into the Config file that's generated upon configuring and compiling perl.
36# $^X works better in some cases to return the path to perl used to launch the script,
37# but if launched with plain "perl" (no full-path), that will be just what it returns.
38use Config;
39# New module for file related utility functions - intended as a
40# placeholder for an extension that allows a variety of different
41# filesystems (FTP, HTTP, SAMBA, WEBDav, HDFS etc)
42use FileUtils;
43
44# removes files (but not directories)
45sub rm {
46 warnings::warnif("deprecated", "util::rm() is deprecated, using FileUtils::removeFiles() instead");
47 return &FileUtils::removeFiles(@_);
48}
49
50# recursive removal
51sub filtered_rm_r {
52 warnings::warnif("deprecated", "util::filtered_rm_r() is deprecated, using FileUtils::removeFilesFiltered() instead");
53 return &FileUtils::removeFilesFiltered(@_);
54}
55
56# recursive removal
57sub rm_r {
58 warnings::warnif("deprecated", "util::rm_r() is deprecated, using FileUtils::removeFilesRecursive() instead");
59 return &FileUtils::removeFilesRecursive(@_);
60}
61
62# moves a file or a group of files
63sub mv {
64 warnings::warnif("deprecated", "util::mv() is deprecated, using FileUtils::moveFiles() instead");
65 return &FileUtils::moveFiles(@_);
66}
67
68# Move the contents of source directory into target directory
69# (as opposed to merely replacing target dir with the src dir)
70# This can overwrite any files with duplicate names in the target
71# but other files and folders in the target will continue to exist
72sub mv_dir_contents {
73 warnings::warnif("deprecated", "util::mv_dir_contents() is deprecated, using FileUtils::moveDirectoryContents() instead");
74 return &FileUtils::moveDirectoryContents(@_);
75}
76
77# copies a file or a group of files
78sub cp {
79 warnings::warnif("deprecated", "util::cp() is deprecated, using FileUtils::copyFiles() instead");
80 return &FileUtils::copyFiles(@_);
81}
82
83# recursively copies a file or group of files
84# syntax: cp_r (sourcefiles, destination directory)
85# destination must be a directory - to copy one file to
86# another use cp instead
87sub cp_r {
88 warnings::warnif("deprecated", "util::cp_r() is deprecated, using FileUtils::copyFilesrecursive() instead");
89 return &FileUtils::copyFilesRecursive(@_);
90}
91
92# recursively copies a file or group of files
93# syntax: cp_r (sourcefiles, destination directory)
94# destination must be a directory - to copy one file to
95# another use cp instead
96sub cp_r_nosvn {
97 warnings::warnif("deprecated", "util::cp_r_nosvn() is deprecated, using FileUtils::copyFilesRecursiveNoSVN() instead");
98 return &FileUtils::copyFilesRecursiveNoSVN(@_);
99}
100
101# copies a directory and its contents, excluding subdirectories, into a new directory
102sub cp_r_toplevel {
103 warnings::warnif("deprecated", "util::cp_r_toplevel() is deprecated, using FileUtils::recursiveCopyTopLevel() instead");
104 return &FileUtils::recursiveCopyTopLevel(@_);
105}
106
107sub mk_dir {
108 warnings::warnif("deprecated", "util::mk_dir() is deprecated, using FileUtils::makeDirectory() instead");
109 return &FileUtils::makeDirectory(@_);
110}
111
112# in case anyone cares - I did some testing (using perls Benchmark module)
113# on this subroutine against File::Path::mkpath (). mk_all_dir() is apparently
114# slightly faster (surprisingly) - Stefan.
115sub mk_all_dir {
116 warnings::warnif("deprecated", "util::mk_all_dir() is deprecated, using FileUtils::makeAllDirectories() instead");
117 return &FileUtils::makeAllDirectories(@_);
118}
119
120# make hard link to file if supported by OS, otherwise copy the file
121sub hard_link {
122 warnings::warnif("deprecated", "util::hard_link() is deprecated, using FileUtils::hardLink() instead");
123 return &FileUtils::hardLink(@_);
124}
125
126# make soft link to file if supported by OS, otherwise copy file
127sub soft_link {
128 warnings::warnif("deprecated", "util::soft_link() is deprecated, using FileUtils::softLink() instead");
129 return &FileUtils::softLink(@_);
130}
131
132# Primarily for filenames generated by processing
133# content of HTML files (which are mapped to UTF-8 internally)
134#
135# To turn this into an octet string that really exists on the file
136# system:
137# 1. don't need to do anything special for Unix-based systems
138# (as underlying file system is byte-code)
139# 2. need to map to short DOS filenames for Windows
140
141sub utf8_to_real_filename
142{
143 my ($utf8_filename) = @_;
144
145 my $real_filename;
146
147 if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
148 require Win32;
149
150 print STDERR "***** utf8 filename = $utf8_filename\n\n\n";
151
152 my $unicode_filename = decode("utf8",$utf8_filename);
153 $real_filename = Win32::GetShortPathName($unicode_filename);
154 }
155 else {
156 $real_filename = $utf8_filename;
157 }
158
159 return $real_filename;
160}
161
162sub fd_exists {
163 warnings::warnif("deprecated", "util::fd_exists() is deprecated, using FileUtils::fileTest() instead");
164 return &FileUtils::fileTest(@_);
165}
166
167sub file_exists {
168 warnings::warnif("deprecated", "util::file_exists() is deprecated, using FileUtils::fileExists() instead");
169 return &FileUtils::fileExists(@_);
170}
171
172sub dir_exists {
173 warnings::warnif("deprecated", "util::dir_exists() is deprecated, using FileUtils::directoryExists() instead");
174 return &FileUtils::directoryExists(@_);
175}
176
177# updates a copy of a directory in some other part of the filesystem
178# verbosity settings are: 0=low, 1=normal, 2=high
179# both $fromdir and $todir should be absolute paths
180sub cachedir {
181 warnings::warnif("deprecated", "util::cachedir() is deprecated, using FileUtils::synchronizeDirectories() instead");
182 return &FileUtils::synchronizeDirectories(@_);
183}
184
185# this function returns -1 if either file is not found
186# assumes that $file1 and $file2 are absolute file names or
187# in the current directory
188# $file2 is allowed to be newer than $file1
189sub differentfiles {
190 warnings::warnif("deprecated", "util::differentfiles() is deprecated, using FileUtils::differentFiles() instead");
191 return &FileUtils::differentFiles(@_);
192}
193
194
195sub get_tmp_filename
196{
197 my $file_ext = shift(@_) || undef;
198
199 my $opt_dot_file_ext = "";
200 if (defined $file_ext) {
201 if ($file_ext !~ m/\./) {
202 # no dot, so needs one added in at start
203 $opt_dot_file_ext = ".$file_ext"
204 }
205 else {
206 # allow for "extensions" such as _metadata.txt to be handled
207 # gracefully
208 $opt_dot_file_ext = $file_ext;
209 }
210 }
211
212 my $tmpdir = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "tmp");
213 &FileUtils::makeAllDirectories ($tmpdir) unless -e $tmpdir;
214
215 my $count = 1000;
216 my $rand = int(rand $count);
217 my $full_tmp_filename = &FileUtils::filenameConcatenate($tmpdir, "F$rand$opt_dot_file_ext");
218
219 while (-e $full_tmp_filename) {
220 $rand = int(rand $count);
221 $full_tmp_filename = &FileUtils::filenameConcatenate($tmpdir, "F$rand$opt_dot_file_ext");
222 $count++;
223 }
224
225 return $full_tmp_filename;
226}
227
228sub get_timestamped_tmp_folder
229{
230
231 my $tmp_dirname;
232 if(defined $ENV{'GSDLCOLLECTDIR'}) {
233 $tmp_dirname = $ENV{'GSDLCOLLECTDIR'};
234 } elsif(defined $ENV{'GSDLHOME'}) {
235 $tmp_dirname = $ENV{'GSDLHOME'};
236 } else {
237 return undef;
238 }
239
240 $tmp_dirname = &FileUtils::filenameConcatenate($tmp_dirname, "tmp");
241 &FileUtils::makeDirectory($tmp_dirname) if (!-e $tmp_dirname);
242
243 # add the timestamp into the path otherwise we can run into problems
244 # if documents have the same name
245 my $timestamp = time;
246 my $time_tmp_dirname = &FileUtils::filenameConcatenate($tmp_dirname, $timestamp);
247 $tmp_dirname = $time_tmp_dirname;
248 my $i = 1;
249 while (-e $tmp_dirname) {
250 $tmp_dirname = "$time_tmp_dirname$i";
251 $i++;
252 }
253 &FileUtils::makeDirectory($tmp_dirname);
254
255 return $tmp_dirname;
256}
257
258sub get_timestamped_tmp_filename_in_collection
259{
260
261 my ($input_filename, $output_ext) = @_;
262 # derive tmp filename from input filename
263 my ($tailname, $dirname, $suffix)
264 = &File::Basename::fileparse($input_filename, "\\.[^\\.]+\$");
265
266 # softlink to collection tmp dir
267 my $tmp_dirname = &util::get_timestamped_tmp_folder();
268 $tmp_dirname = $dirname unless defined $tmp_dirname;
269
270 # following two steps copied from ConvertBinaryFile
271 # do we need them?? can't use them as is, as they use plugin methods.
272
273 #$tailname = $self->SUPER::filepath_to_utf8($tailname) unless &unicode::check_is_utf8($tailname);
274
275 # URLEncode this since htmls with images where the html filename is utf8 don't seem
276 # to work on Windows (IE or Firefox), as browsers are looking for filesystem-encoded
277 # files on the filesystem.
278 #$tailname = &util::rename_file($tailname, $self->{'file_rename_method'}, "without_suffix");
279 if (defined $output_ext) {
280 $output_ext = ".$output_ext"; # add the dot
281 } else {
282 $output_ext = $suffix;
283 }
284 $output_ext= lc($output_ext);
285 my $tmp_filename = &FileUtils::filenameConcatenate($tmp_dirname, "$tailname$output_ext");
286
287 return $tmp_filename;
288}
289
290sub get_toplevel_tmp_dir
291{
292 return &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "tmp");
293}
294
295
296sub filename_to_regex {
297 my $filename = shift (@_);
298
299 # need to make single backslashes double so that regex works
300 $filename =~ s/\\/\\\\/g; # if ($ENV{'GSDLOS'} =~ /^windows$/i);
301
302 # note that the first part of a substitution is a regex, so RE chars need to be escaped,
303 # the second part of a substitution is not a regex, so for e.g. full-stop can be specified literally
304 $filename =~ s/\./\\./g; # in case there are extensions/other full stops, escape them
305 $filename =~ s@\(@\\(@g; # escape brackets
306 $filename =~ s@\)@\\)@g; # escape brackets
307 $filename =~ s@\[@\\[@g; # escape brackets
308 $filename =~ s@\]@\\]@g; # escape brackets
309
310 return $filename;
311}
312
313sub unregex_filename {
314 my $filename = shift (@_);
315
316 # need to put doubled backslashes for regex back to single
317 $filename =~ s/\\\./\./g; # remove RE syntax for .
318 $filename =~ s@\\\(@(@g; # remove RE syntax for ( => "\(" turns into "("
319 $filename =~ s@\\\)@)@g; # remove RE syntax for ) => "\)" turns into ")"
320 $filename =~ s@\\\[@[@g; # remove RE syntax for [ => "\[" turns into "["
321 $filename =~ s@\\\]@]@g; # remove RE syntax for ] => "\]" turns into "]"
322
323 # \\ goes to \
324 # This is the last step in reverse mirroring the order of steps in filename_to_regex()
325 $filename =~ s/\\\\/\\/g; # remove RE syntax for \
326 return $filename;
327}
328
329sub filename_cat {
330 # I've disabled this warning for now, as every Greenstone perl
331 # script seems to make use of this function and so you drown in a
332 # sea of deprecated warnings [jmt12]
333# warnings::warnif("deprecated", "util::filename_cat() is deprecated, using FileUtils::filenameConcatenate() instead");
334 return &FileUtils::filenameConcatenate(@_);
335}
336
337
338sub pathname_cat {
339 my $first_path = shift(@_);
340 my (@pathnames) = @_;
341
342 # If first_path is not null or empty, then add it back into the list
343 if (defined $first_path && $first_path =~ /\S/) {
344 unshift(@pathnames, $first_path);
345 }
346
347 my $join_char;
348 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
349 $join_char = ";";
350 } else {
351 $join_char = ":";
352 }
353
354 my $pathname = join($join_char, @pathnames);
355
356 # remove duplicate slashes
357 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
358 $pathname =~ s/[\\\/]+/\\/g;
359 } else {
360 $pathname =~ s/[\/]+/\//g;
361 # DB: want a pathname abc\de.html to remain like this
362 }
363
364 return $pathname;
365}
366
367
368sub tidy_up_oid {
369 my ($OID) = @_;
370 if ($OID =~ /\./) {
371 print STDERR "Warning, identifier $OID contains periods (.), removing them\n";
372 $OID =~ s/\.//g; #remove any periods
373 }
374 if ($OID =~ /^\s.*\s$/) {
375 print STDERR "Warning, identifier $OID starts or ends with whitespace. Removing it\n";
376 # remove starting and trailing whitespace
377 $OID =~ s/^\s+//;
378 $OID =~ s/\s+$//;
379 }
380 if ($OID =~ /^[\d]*$/) {
381 print STDERR "Warning, identifier $OID contains only digits. Prepending 'D'.\n";
382 $OID = "D" . $OID;
383 }
384
385 return $OID;
386}
387
388sub envvar_prepend {
389 my ($var,$val) = @_;
390
391 # 64 bit linux can't handle ";" as path separator, so make sure to set this to the right one for the OS
392 my $pathsep = (defined $ENV{'GSDLOS'} && $ENV{'GSDLOS'} !~ m/windows/) ? ":" : ";";
393
394 # do not prepend any value/path that's already in the environment variable
395
396 my $escaped_val = &filename_to_regex($val); # escape any backslashes and brackets for upcoming regex
397 if (!defined($ENV{$var})) {
398 $ENV{$var} = "$val";
399 }
400 elsif($ENV{$var} !~ m/$escaped_val/) {
401 $ENV{$var} = "$val".$pathsep.$ENV{$var};
402 }
403}
404
405sub envvar_append {
406 my ($var,$val) = @_;
407
408 # 64 bit linux can't handle ";" as path separator, so make sure to set this to the right one for the OS
409 my $pathsep = (defined $ENV{'GSDLOS'} && $ENV{'GSDLOS'} !~ m/windows/) ? ":" : ";";
410
411 # do not append any value/path that's already in the environment variable
412
413 my $escaped_val = &filename_to_regex($val); # escape any backslashes and brackets for upcoming regex
414 if (!defined($ENV{$var})) {
415 $ENV{$var} = "$val";
416 }
417 elsif($ENV{$var} !~ m/$escaped_val/) {
418 $ENV{$var} = $ENV{$var}.$pathsep."$val";
419 }
420}
421
422
423# splits a filename into a prefix and a tail extension using the tail_re, or
424# if that fails, splits on the file_extension . (dot)
425sub get_prefix_and_tail_by_regex {
426
427 my ($filename,$tail_re) = @_;
428
429 my ($file_prefix,$file_ext) = ($filename =~ m/^(.*?)($tail_re)$/);
430 if ((!defined $file_prefix) || (!defined $file_ext)) {
431 ($file_prefix,$file_ext) = ($filename =~ m/^(.*)(\..*?)$/);
432 }
433
434 return ($file_prefix,$file_ext);
435}
436
437# get full path and file only path from a base_dir (which may be empty) and
438# file (which may contain directories)
439sub get_full_filenames {
440 my ($base_dir, $file) = @_;
441
442 my $filename_full_path = $file;
443 # add on directory if present
444 $filename_full_path = &FileUtils::filenameConcatenate($base_dir, $file) if $base_dir =~ /\S/;
445
446 my $filename_no_path = $file;
447
448 # remove directory if present
449 $filename_no_path =~ s/^.*[\/\\]//;
450 return ($filename_full_path, $filename_no_path);
451}
452
453# returns the path of a file without the filename -- ie. the directory the file is in
454sub filename_head {
455 my $filename = shift(@_);
456
457 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
458 $filename =~ s/[^\\\\]*$//;
459 }
460 else {
461 $filename =~ s/[^\\\/]*$//;
462 }
463
464 return $filename;
465}
466
467
468
469# returns 1 if filename1 and filename2 point to the same
470# file or directory
471sub filenames_equal {
472 my ($filename1, $filename2) = @_;
473
474 # use filename_cat to clean up trailing slashes and
475 # multiple slashes
476 $filename1 = &FileUtils::filenameConcatenate($filename1);
477 $filename2 = &FileUtils::filenameConcatenate($filename2);
478
479 # filenames not case sensitive on windows
480 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
481 $filename1 =~ tr/[A-Z]/[a-z]/;
482 $filename2 =~ tr/[A-Z]/[a-z]/;
483 }
484 return 1 if $filename1 eq $filename2;
485 return 0;
486}
487
488# If filename is relative to within_dir, returns the relative path of filename to that directory
489# with slashes in the filename returned as they were in the original (absolute) filename.
490sub filename_within_directory
491{
492 my ($filename,$within_dir) = @_;
493
494 if ($within_dir !~ m/[\/\\]$/) {
495 my $dirsep = &util::get_dirsep();
496 $within_dir .= $dirsep;
497 }
498
499 $within_dir = &filename_to_regex($within_dir); # escape DOS style file separator and brackets
500 if ($filename =~ m/^$within_dir(.*)$/) {
501 $filename = $1;
502 }
503
504 return $filename;
505}
506
507# If filename is relative to within_dir, returns the relative path of filename to that directory in URL format.
508# Filename and within_dir can be any type of slashes, but will be compared as URLs (i.e. unix-style slashes).
509# The subpath returned will also be a URL type filename.
510sub filename_within_directory_url_format
511{
512 my ($filename,$within_dir) = @_;
513
514 # convert parameters only to / slashes if Windows
515
516 my $filename_urlformat = &filepath_to_url_format($filename);
517 my $within_dir_urlformat = &filepath_to_url_format($within_dir);
518
519 #if ($within_dir_urlformat !~ m/\/$/) {
520 # make sure directory ends with a slash
521 #$within_dir_urlformat .= "/";
522 #}
523
524 my $within_dir_urlformat_re = &filename_to_regex($within_dir_urlformat); # escape any special RE characters, such as brackets
525
526 #print STDERR "@@@@@ $filename_urlformat =~ $within_dir_urlformat_re\n";
527
528 # dir prefix may or may not end with a slash (this is discarded when extracting the sub-filepath)
529 if ($filename_urlformat =~ m/^$within_dir_urlformat_re(?:\/)*(.*)$/) {
530 $filename_urlformat = $1;
531 }
532
533 return $filename_urlformat;
534}
535
536# Convert parameter to use / slashes if Windows (if on Linux leave any \ as is,
537# since on Linux it doesn't represent a file separator but an escape char).
538sub filepath_to_url_format
539{
540 my ($filepath) = @_;
541 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
542 # Only need to worry about Windows, as Unix style directories already in url-format
543 # Convert Windows style \ => /
544 $filepath =~ s@\\@/@g;
545 }
546 return $filepath;
547}
548
549# regex filepaths on windows may include \\ as path separator. Convert \\ to /
550sub filepath_regex_to_url_format
551{
552 my ($filepath) = @_;
553 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
554 # Only need to worry about Windows, as Unix style directories already in url-format
555 # Convert Windows style \\ => /
556 $filepath =~ s@\\\\@/@g;
557 }
558 return $filepath;
559
560}
561
562# Like File::Basename::fileparse, but expects filepath in url format (ie only / slash for dirsep)
563# and ignores trailing /
564# returns (file, dirs) dirs will be empty if no subdirs
565sub url_fileparse
566{
567 my ($filepath) = @_;
568 # remove trailing /
569 $filepath =~ s@/$@@;
570 if ($filepath !~ m@/@) {
571 return ($filepath, "");
572 }
573 my ($dirs, $file) = $filepath =~ m@(.+/)([^/]+)@;
574 return ($file, $dirs);
575
576}
577
578
579sub filename_within_collection
580{
581 my ($filename) = @_;
582
583 my $collect_dir = $ENV{'GSDLCOLLECTDIR'};
584
585 if (defined $collect_dir) {
586
587 # if from within GSDLCOLLECTDIR, then remove directory prefix
588 # so source_filename is realative to it. This is done to aid
589 # portability, i.e. the collection can be moved to somewhere
590 # else on the file system and the archives directory will still
591 # work. This is needed, for example in the applet version of
592 # GLI where GSDLHOME/collect on the server will be different to
593 # the collect directory of the remove user. Of course,
594 # GSDLCOLLECTDIR subsequently needs to be put back on to turn
595 # it back into a full pathname.
596
597 $filename = filename_within_directory($filename,$collect_dir);
598 }
599
600 return $filename;
601}
602
603sub prettyprint_file
604{
605 my ($base_dir,$file,$gli) = @_;
606
607 my $filename_full_path = &FileUtils::filenameConcatenate($base_dir,$file);
608
609 if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
610 require Win32;
611
612 # For some reason base_dir in the form c:/a/b/c
613 # This leads to confusion later on, so turn it back into
614 # the more usual Windows form
615 $base_dir =~ s/\//\\/g;
616 my $long_base_dir = Win32::GetLongPathName($base_dir);
617 my $long_full_path = Win32::GetLongPathName($filename_full_path);
618
619 $file = filename_within_directory($long_full_path,$long_base_dir);
620 $file = encode("utf8",$file) if ($gli);
621 }
622
623 return $file;
624}
625
626
627sub upgrade_if_dos_filename
628{
629 my ($filename_full_path,$and_encode) = @_;
630
631 if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
632 # Ensure any DOS-like filename, such as test~1.txt, has been upgraded
633 # to its long (Windows) version
634 my $long_filename = Win32::GetLongPathName($filename_full_path);
635 if (defined $long_filename) {
636 $filename_full_path = $long_filename;
637 }
638 # Make sure initial drive letter is lower-case (to fit in with rest of Greenstone)
639 $filename_full_path =~ s/^(.):/\u$1:/;
640 if ((defined $and_encode) && ($and_encode)) {
641 $filename_full_path = encode("utf8",$filename_full_path);
642 }
643 }
644
645 return $filename_full_path;
646}
647
648
649sub downgrade_if_dos_filename
650{
651 my ($filename_full_path) = @_;
652
653 if ($ENV{'GSDLOS'} =~ m/^windows$/i) {
654 require Win32;
655
656 # Ensure the given long Windows filename is in a form that can
657 # be opened by Perl => convert it to a short DOS-like filename
658
659 my $short_filename = Win32::GetShortPathName($filename_full_path);
660 if (defined $short_filename) {
661 $filename_full_path = $short_filename;
662 }
663 # Make sure initial drive letter is lower-case (to fit in
664 # with rest of Greenstone)
665 $filename_full_path =~ s/^(.):/\u$1:/;
666 }
667
668 return $filename_full_path;
669}
670
671sub block_filename
672{
673 my ($block_hash,$filename) = @_;
674
675 if ($ENV{'GSDLOS'} =~ m/^windows$/) {
676
677 # lower case the entire thing, eg for cover.jpg when its actually cover.JPG
678 my $lower_filename = lc($filename);
679 $block_hash->{'file_blocks'}->{$lower_filename} = 1;
680# my $lower_drive = $filename;
681# $lower_drive =~ s/^([A-Z]):/\l$1:/i;
682
683# my $upper_drive = $filename;
684# $upper_drive =~ s/^([A-Z]):/\u$1:/i;
685#
686# $block_hash->{'file_blocks'}->{$lower_drive} = 1;
687# $block_hash->{'file_blocks'}->{$upper_drive} = 1;
688 }
689 else {
690 $block_hash->{'file_blocks'}->{$filename} = 1;
691 }
692}
693
694
695sub filename_is_absolute
696{
697 warnings::warnif("deprecated", "util::filename_is_absolute() is deprecated, using FileUtils::isFilenameAbsolute() instead");
698 return &FileUtils::isFilenameAbsolute(@_);
699}
700
701
702## @method make_absolute()
703#
704# Ensure the given file path is absolute in respect to the given base path.
705#
706# @param $base_dir A string denoting the base path the given dir must be
707# absolute to.
708# @param $dir The directory to be made absolute as a string. Note that the
709# dir may already be absolute, in which case it will remain
710# unchanged.
711# @return The now absolute form of the directory as a string.
712#
713# @author John Thompson, DL Consulting Ltd.
714# @copy 2006 DL Consulting Ltd.
715#
716#used in buildcol.pl, doesn't work for all cases --kjdon
717sub make_absolute {
718
719 my ($base_dir, $dir) = @_;
720### print STDERR "dir = $dir\n";
721 $dir =~ s/[\\\/]+/\//g;
722 $dir = $base_dir . "/$dir" unless ($dir =~ m|^(\w:)?/|);
723 $dir =~ s|^/tmp_mnt||;
724 1 while($dir =~ s|/[^/]*/\.\./|/|g);
725 $dir =~ s|/[.][.]?/|/|g;
726 $dir =~ tr|/|/|s;
727### print STDERR "dir = $dir\n";
728
729 return $dir;
730}
731## make_absolute() ##
732
733sub get_dirsep {
734
735 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
736 return "\\";
737 } else {
738 return "\/";
739 }
740}
741
742sub get_os_dirsep {
743
744 if ($ENV{'GSDLOS'} =~ /^windows$/i) {
745 return "\\\\";
746 } else {
747 return "\\\/";
748 }
749}
750
751sub get_re_dirsep {
752
753 return "\\\\|\\\/";
754}
755
756
757sub get_dirsep_tail {
758 my ($filename) = @_;
759
760 # returns last part of directory or filename
761 # On unix e.g. a/b.d => b.d
762 # a/b/c => c
763
764 my $dirsep = get_re_dirsep();
765 my @dirs = split (/$dirsep/, $filename);
766 my $tail = pop @dirs;
767
768 # - caused problems under windows
769 #my ($tail) = ($filename =~ m/^(?:.*?$dirsep)?(.*?)$/);
770
771 return $tail;
772}
773
774
775# if this is running on windows we want binaries to end in
776# .exe, otherwise they don't have to end in any extension
777sub get_os_exe {
778 return ".exe" if $ENV{'GSDLOS'} =~ /^windows$/i;
779 return "";
780}
781
782
783# test to see whether this is a big or little endian machine
784sub is_little_endian
785{
786 # To determine the name of the operating system, the variable $^O is a cheap alternative to pulling it out of the Config module;
787 # If it is a Macintosh machine (i.e. the Darwin operating system), regardless if it's running on the IBM power-pc cpu or the x86 Intel-based chip with a power-pc emulator running on top of it, it's big-endian
788 # Otherwise, it's little endian
789
790 #return 0 if $^O =~ /^darwin$/i;
791 #return 0 if $ENV{'GSDLOS'} =~ /^darwin$/i;
792
793 # Going back to stating exactly whether the machine is little endian
794 # or big endian, without any special case for Macs. Since for rata it comes
795 # back with little endian and for shuttle with bigendian.
796 return (ord(substr(pack("s",1), 0, 1)) == 1);
797}
798
799
800# will return the collection name if successful, "" otherwise
801sub use_collection {
802 my ($collection, $collectdir) = @_;
803
804 if (!defined $collectdir || $collectdir eq "") {
805 $collectdir = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "collect");
806 }
807
808 # get and check the collection
809 if (!defined($collection) || $collection eq "") {
810 if (defined $ENV{'GSDLCOLLECTION'}) {
811 $collection = $ENV{'GSDLCOLLECTION'};
812 } else {
813 print STDOUT "No collection specified\n";
814 return "";
815 }
816 }
817
818 if ($collection eq "modelcol") {
819 print STDOUT "You can't use modelcol.\n";
820 return "";
821 }
822
823 # make sure the environment variables GSDLCOLLECTION and GSDLCOLLECTDIR
824 # are defined
825 $ENV{'GSDLCOLLECTION'} = $collection;
826 $ENV{'GSDLCOLLECTDIR'} = &FileUtils::filenameConcatenate($collectdir, $collection);
827
828 # make sure this collection exists
829 if (!-e $ENV{'GSDLCOLLECTDIR'}) {
830 print STDOUT "Invalid collection ($collection).\n";
831 return "";
832 }
833
834 # everything is ready to go
835 return $collection;
836}
837
838sub get_current_collection_name {
839 return $ENV{'GSDLCOLLECTION'};
840}
841
842
843# will return the collection name if successful, "" otherwise.
844# Like use_collection (above) but for greenstone 3 (taking account of site level)
845
846sub use_site_collection {
847 my ($site, $collection, $collectdir) = @_;
848
849 if (!defined $collectdir || $collectdir eq "") {
850 die "GSDL3HOME not set.\n" unless defined $ENV{'GSDL3HOME'};
851 $collectdir = &FileUtils::filenameConcatenate($ENV{'GSDL3HOME'}, "sites", $site, "collect");
852 }
853
854 # collectdir explicitly set by this point (using $site variable if required).
855 # Can call "old" gsdl2 use_collection now.
856
857 return use_collection($collection,$collectdir);
858}
859
860
861
862sub locate_config_file
863{
864 my ($file) = @_;
865
866 my $locations = locate_config_files($file);
867
868 return shift @$locations; # returns undef if 'locations' is empty
869}
870
871
872sub locate_config_files
873{
874 my ($file) = @_;
875
876 my @locations = ();
877
878 if (-e $file) {
879 # Clearly specified (most likely full filename)
880 # No need to hunt in 'etc' directories, return value unchanged
881 push(@locations,$file);
882 }
883 else {
884 # Check for collection specific one before looking in global GSDL 'etc'
885 if (defined $ENV{'GSDLCOLLECTDIR'} && $ENV{'GSDLCOLLECTDIR'} ne "") {
886 my $test_collect_etc_filename
887 = &FileUtils::filenameConcatenate($ENV{'GSDLCOLLECTDIR'},"etc", $file);
888
889 if (-e $test_collect_etc_filename) {
890 push(@locations,$test_collect_etc_filename);
891 }
892 }
893 my $test_main_etc_filename
894 = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"etc", $file);
895 if (-e $test_main_etc_filename) {
896 push(@locations,$test_main_etc_filename);
897 }
898 }
899
900 return \@locations;
901}
902
903
904sub hyperlink_text
905{
906 my ($text) = @_;
907
908 $text =~ s/(http:\/\/[^\s]+)/<a href=\"$1\">$1<\/a>/mg;
909 $text =~ s/(^|\s+)(www\.(\w|\.)+)/<a href=\"http:\/\/$2\">$2<\/a>/mg;
910
911 return $text;
912}
913
914
915# A method to check if a directory is empty (note that an empty directory still has non-zero size!!!)
916# Code is from http://episteme.arstechnica.com/eve/forums/a/tpc/f/6330927813/m/436007700831
917sub is_dir_empty {
918 warnings::warnif("deprecated", "util::is_dir_empty() is deprecated, using FileUtils::isDirectoryEmpty() instead");
919 return &FileUtils::isDirectoryEmpty(@_);
920}
921
922# Returns the given filename converted using either URL encoding or base64
923# encoding, as specified by $rename_method. If the given filename has no suffix
924# (if it is just the tailname), then $no_suffix should be some defined value.
925# rename_method can be url, none, base64
926sub rename_file {
927 my ($filename, $rename_method, $no_suffix) = @_;
928
929 if(!$filename) { # undefined or empty string
930 return $filename;
931 }
932
933 if (!$rename_method) {
934 print STDERR "WARNING: no file renaming method specified. Defaulting to using URL encoding...\n";
935 # Debugging information
936 # my ($cpackage,$cfilename,$cline,$csubr,$chas_args,$cwantarray) = caller(1);
937 # print STDERR "Called from method: $cfilename:$cline $cpackage->$csubr\n";
938 $rename_method = "url";
939 } elsif($rename_method eq "none") {
940 return $filename; # would have already been renamed
941 }
942
943 # No longer replace spaces with underscores, since underscores mess with incremental rebuild
944 ### Replace spaces with underscore. Do this first else it can go wrong below when getting tailname
945 ###$filename =~ s/ /_/g;
946
947 my ($tailname,$dirname,$suffix);
948 if($no_suffix) { # given a tailname, no suffix
949 ($tailname,$dirname) = File::Basename::fileparse($filename);
950 }
951 else {
952 ($tailname,$dirname,$suffix) = File::Basename::fileparse($filename, "\\.(?:[^\\.]+?)\$");
953 }
954 if (!$suffix) {
955 $suffix = "";
956 }
957 # This breaks GLI matching extracted metadata to files in Enrich panel, as
958 # original is eg .JPG while gsdlsourcefilename ends up .jpg
959 # Not sure why it was done in first place...
960 #else {
961 #$suffix = lc($suffix);
962 #}
963
964 if ($rename_method eq "url") {
965 $tailname = &unicode::url_encode($tailname);
966 }
967 elsif ($rename_method eq "base64") {
968 $tailname = &unicode::base64_encode($tailname);
969 $tailname =~ s/\s*//sg; # for some reason it adds spaces not just at end but also in middle
970 }
971
972 $filename = "$tailname$suffix";
973 $filename = "$dirname$filename" if ($dirname ne "./" && $dirname ne ".\\");
974
975 return $filename;
976}
977
978
979# BACKWARDS COMPATIBILITY: Just in case there are old .ldb/.bdb files
980sub rename_ldb_or_bdb_file {
981 my ($filename_no_ext) = @_;
982
983 my $new_filename = "$filename_no_ext.gdb";
984 return if (-f $new_filename); # if the file has the right extension, don't need to do anything
985 # try ldb
986 my $old_filename = "$filename_no_ext.ldb";
987
988 if (-f $old_filename) {
989 print STDERR "Renaming $old_filename to $new_filename\n";
990 rename ($old_filename, $new_filename)
991 || print STDERR "Rename failed: $!\n";
992 return;
993 }
994 # try bdb
995 $old_filename = "$filename_no_ext.bdb";
996 if (-f $old_filename) {
997 print STDERR "Renaming $old_filename to $new_filename\n";
998 rename ($old_filename, $new_filename)
999 || print STDERR "Rename failed: $!\n";
1000 return;
1001 }
1002}
1003
1004sub os_dir() {
1005
1006 my $gsdlarch = "";
1007 if(defined $ENV{'GSDLARCH'}) {
1008 $gsdlarch = $ENV{'GSDLARCH'};
1009 }
1010 return $ENV{'GSDLOS'}.$gsdlarch;
1011}
1012
1013# Returns the greenstone URL prefix extracted from the appropriate GS2/GS3 config file.
1014# By default, /greenstone3 for GS3 or /greenstone for GS2.
1015sub get_greenstone_url_prefix() {
1016 # if already set on a previous occasion, just return that
1017 # (Don't want to keep repeating this: cost of re-opening and scanning files.)
1018 return $ENV{'GREENSTONE_URL_PREFIX'} if($ENV{'GREENSTONE_URL_PREFIX'});
1019
1020 my ($configfile, $urlprefix, $defaultUrlprefix);
1021 my @propertynames = ();
1022
1023 if($ENV{'GSDL3SRCHOME'}) {
1024 $defaultUrlprefix = "/greenstone3";
1025 $configfile = &FileUtils::filenameConcatenate($ENV{'GSDL3SRCHOME'}, "packages", "tomcat", "conf", "Catalina", "localhost", "greenstone3.xml");
1026 push(@propertynames, qw/path\s*\=/);
1027 } else {
1028 $defaultUrlprefix = "/greenstone";
1029 $configfile = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'}, "cgi-bin", &os_dir(), "gsdlsite.cfg");
1030 push(@propertynames, (qw/\nhttpprefix/, qw/\ngwcgi/)); # inspect one property then the other
1031 }
1032
1033 $urlprefix = &extract_propvalue_from_file($configfile, \@propertynames);
1034
1035 if(!$urlprefix) { # no values found for URL prefix, use default values
1036 $urlprefix = $defaultUrlprefix;
1037 } else {
1038 #gwcgi can contain more than the wanted prefix, we split on / to get the first "directory" level
1039 $urlprefix =~ s/^\///; # remove the starting slash
1040 my @dirs = split(/(\\|\/)/, $urlprefix);
1041 $urlprefix = shift(@dirs);
1042
1043 if($urlprefix !~ m/^\//) { # in all cases: ensure the required forward slash is at the front
1044 $urlprefix = "/$urlprefix";
1045 }
1046 }
1047
1048 # set for the future
1049 $ENV{'GREENSTONE_URL_PREFIX'} = $urlprefix;
1050# print STDERR "*** in get_greenstone_url_prefix(): $urlprefix\n\n";
1051 return $urlprefix;
1052}
1053
1054
1055# Given a config file (xml or java properties file) and a list/array of regular expressions
1056# that represent property names to match on, this function will return the value for the 1st
1057# matching property name. If the return value is undefined, no matching property was found.
1058sub extract_propvalue_from_file() {
1059 my ($configfile, $propertynames) = @_;
1060
1061 my $value;
1062 unless(open(FIN, "<$configfile")) {
1063 print STDERR "extract_propvalue_from_file(): Unable to open $configfile. $!\n";
1064 return $value; # not initialised
1065 }
1066
1067 # Read the entire file at once, as one single line, then close it
1068 my $filecontents;
1069 {
1070 local $/ = undef;
1071 $filecontents = <FIN>;
1072 }
1073 close(FIN);
1074
1075 foreach my $regex (@$propertynames) {
1076 ($value) = $filecontents=~ m/$regex\s*(\S*)/s; # read value of the property given by regex up to the 1st space
1077 if($value) {
1078 $value =~ s/^\"//; # remove any startquotes
1079 $value =~ s/\".*$//; # remove the 1st endquotes (if any) followed by any xml
1080 last; # found value for a matching property, break from loop
1081 }
1082 }
1083
1084 return $value;
1085}
1086
1087# Subroutine that sources setup.bash, given GSDLHOME and GSDLOS and
1088# given that perllib is in @INC in order to invoke this subroutine.
1089# Call as follows -- after setting up INC to include perllib and
1090# after setting up GSDLHOME and GSDLOS:
1091#
1092# require util;
1093# &util::setup_greenstone_env($ENV{'GSDLHOME'}, $ENV{'GSDLOS'});
1094#
1095sub setup_greenstone_env() {
1096 my ($GSDLHOME, $GSDLOS) = @_;
1097
1098 #my %env_map = ();
1099 # Get the localised ENV settings of running a localised source setup.bash
1100 # and put it into the ENV here. Need to clear GSDLHOME before running setup
1101 #my $perl_command = "(cd $GSDLHOME; export GSDLHOME=; . ./setup.bash > /dev/null; env)";
1102 my $perl_command = "(cd $GSDLHOME; /bin/bash -c \"export GSDLHOME=; source setup.bash > /dev/null; env\")";
1103 if($GSDLOS =~ m/windows/i) {
1104 #$perl_command = "cmd /C \"cd $GSDLHOME&& set GSDLHOME=&& setup.bat > nul&& set\"";
1105 $perl_command = "(cd $GSDLHOME&& set GSDLHOME=&& setup.bat > nul&& set)";
1106 }
1107 if (!open(PIN, "$perl_command |")) {
1108 print STDERR ("Unable to execute command: $perl_command. $!\n");
1109 }
1110
1111 while (defined (my $perl_output_line = <PIN>)) {
1112 my($key,$value) = ($perl_output_line =~ m/^([^=]*)[=](.*)$/);
1113 #$env_map{$key}=$value;
1114 $ENV{$key}=$value;
1115 }
1116 close (PIN);
1117
1118 # If any keys in $ENV don't occur in Greenstone's localised env
1119 # (stored in $env_map), delete those entries from $ENV
1120 #foreach $key (keys %ENV) {
1121 # if(!defined $env_map{$key}) {
1122 # print STDOUT "**** DELETING ENV KEY: $key\tVALUE: $ENV{'$key'}\n";
1123 # delete $ENV{$key}; # del $ENV(key, value) pair
1124 # }
1125 #}
1126 #undef %env_map;
1127}
1128
1129sub get_perl_exec() {
1130 my $perl_exec = $^X; # may return just "perl"
1131
1132 if($ENV{'PERLPATH'}) {
1133 # OR: # $perl_exec = &FileUtils::filenameConcatenate($ENV{'PERLPATH'},"perl");
1134 if($ENV{'GSDLOS'} =~ m/windows/) {
1135 $perl_exec = "$ENV{'PERLPATH'}\\Perl.exe";
1136 } else {
1137 $perl_exec = "$ENV{'PERLPATH'}/perl";
1138 }
1139 } else { # no PERLPATH, use Config{perlpath} else $^X: special variables
1140 # containing the full path to the current perl executable we're using
1141 $perl_exec = $Config{perlpath}; # configured path for perl
1142 if (!-e $perl_exec) { # may not point to location on this machine
1143 $perl_exec = $^X; # may return just "perl"
1144 if($perl_exec =~ m/^perl/i) { # warn if just perl or Perl.exe
1145 print STDERR "**** WARNING: Perl exec found contains no path: $perl_exec";
1146 }
1147 }
1148 }
1149
1150 return $perl_exec;
1151}
1152
1153# returns the path to the java command in the JRE included with GS (if any),
1154# quoted to safeguard any spaces in this path, otherwise a simple java
1155# command is returned which assumes and will try for a system java.
1156sub get_java_command {
1157 my $java = "java";
1158 if(defined $ENV{'GSDLHOME'}) { # should be, as this script would be launched from the cmd line
1159 # after running setup.bat or from GLI which also runs setup.bat
1160 my $java_bin = &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"packages","jre","bin");
1161 if(-d $java_bin) {
1162 $java = &FileUtils::filenameConcatenate($java_bin,"java");
1163 $java = "\"".$java."\""; # quoted to preserve spaces in path
1164 }
1165 }
1166 return $java;
1167}
1168
1169
1170# Given the qualified collection name (colgroup/collection),
1171# returns the collection and colgroup parts
1172sub get_collection_parts {
1173 # http://perldoc.perl.org/File/Basename.html
1174 # my($filename, $directories, $suffix) = fileparse($path);
1175 # "$directories contains everything up to and including the last directory separator in the $path
1176 # including the volume (if applicable). The remainder of the $path is the $filename."
1177 #my ($collection, $colgroup) = &File::Basename::fileparse($qualified_collection);
1178
1179 my $qualified_collection = shift(@_);
1180
1181 # Since activate.pl can be launched from the command-line, including by a user,
1182 # best not to assume colgroup uses URL-style slashes as would be the case with GLI
1183 # Also allow for the accidental inclusion of multiple slashes
1184 my ($colgroup, $collection) = split(/[\/\\]+/, $qualified_collection); #split('/', $qualified_collection);
1185
1186 if(!defined $collection) {
1187 $collection = $colgroup;
1188 $colgroup = "";
1189 }
1190 return ($collection, $colgroup);
1191}
1192
1193# work out the "collectdir/collection" location
1194sub resolve_collection_dir {
1195 my ($collect_dir, $qualified_collection, $site) = @_; #, $gs_mode
1196
1197 my ($colgroup, $collection) = &util::get_collection_parts($qualified_collection);
1198
1199 if (defined $collect_dir && $collect_dir) { # ensure not empty string either
1200 return &FileUtils::filenameConcatenate($collect_dir,$colgroup, $collection);
1201 }
1202 elsif (defined($ENV{'GSDLCOLLECTDIR'})) {
1203 return $ENV{'GSDLCOLLECTDIR'};
1204 }
1205 else {
1206 if (defined $site) {
1207 return &FileUtils::filenameConcatenate($ENV{'GSDL3HOME'},"sites",$site,"collect",$colgroup, $collection);
1208 }
1209 else {
1210 return &FileUtils::filenameConcatenate($ENV{'GSDLHOME'},"collect",$colgroup, $collection);
1211 }
1212 }
1213}
1214
1215# Used by pdfpstoimg.pl and PDFBoxConverter to create a .item file from
1216# a directory containing sequentially numbered images.
1217sub create_itemfile
1218{
1219 my ($output_dir, $convert_basename, $convert_to) = @_;
1220 my $page_num = "";
1221
1222 opendir(DIR, $output_dir) || die "can't opendir $output_dir: $!";
1223 my @dir_files = grep {-f "$output_dir/$_"} readdir(DIR);
1224 closedir DIR;
1225
1226 # Sort files in the directory by page_num
1227 sub page_number {
1228 my ($dir) = @_;
1229 my ($pagenum) =($dir =~ m/^.*?[-\.]?(\d+)(\.(jpg|gif|png))?$/i);
1230# my ($pagenum) =($dir =~ m/(\d+)(\.(jpg|gif|png))?$/i); # this works but is not as safe/strict about input filepatterns as the above
1231
1232 $pagenum = 1 unless defined $pagenum;
1233 return $pagenum;
1234 }
1235
1236 # sort the files in the directory in the order of page_num rather than lexically.
1237 @dir_files = sort { page_number($a) <=> page_number($b) } @dir_files;
1238
1239 # work out if the numbering of the now sorted image files starts at 0 or not
1240 # by checking the number of the first _image_ file (skipping item files)
1241 my $starts_at_0 = 0;
1242 my $firstfile = ($dir_files[0] !~ /\.item$/i) ? $dir_files[0] : $dir_files[1];
1243 if(page_number($firstfile) == 0) { # 00 will evaluate to 0 too in this condition
1244 $starts_at_0 = 1;
1245 }
1246
1247 my $item_file = &FileUtils::filenameConcatenate($output_dir, $convert_basename.".item");
1248 my $item_fh;
1249 &FileUtils::openFileHandle($item_file, 'w', \$item_fh);
1250 print $item_fh "<PagedDocument>\n";
1251
1252 foreach my $file (@dir_files){
1253 if ($file !~ /\.item/i){
1254 $page_num = page_number($file);
1255 $page_num++ if $starts_at_0; # image numbers start at 0, so add 1
1256 print $item_fh " <Page pagenum=\"$page_num\" imgfile=\"$file\" txtfile=\"\"/>\n";
1257 }
1258 }
1259
1260 print $item_fh "</PagedDocument>\n";
1261 &FileUtils::closeFileHandle($item_file, \$item_fh);
1262 return $item_file;
1263}
1264
1265
1266## @function augmentINC()
1267#
1268# Prepend a path (if it exists) onto INC but only if it isn't already in INC
1269# @param $new_path The path to add
1270# @author jmt12
1271#
1272sub augmentINC
1273{
1274 my ($new_path) = @_;
1275 my $did_add_path = 0;
1276 # might need to be replaced with FileUtils::directoryExists() call eventually
1277 if (-d $new_path)
1278 {
1279 my $did_find_path = 0;
1280 foreach my $existing_path (@INC)
1281 {
1282 if ($existing_path eq $new_path)
1283 {
1284 $did_find_path = 1;
1285 last;
1286 }
1287 }
1288 if (!$did_find_path)
1289 {
1290 unshift(@INC, $new_path);
1291 $did_add_path = 1;
1292 }
1293 }
1294 return $did_add_path;
1295}
1296## augmentINC()
1297
1298
12991;
Note: See TracBrowser for help on using the repository browser.