/[webpac-proto]/search/Library.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /search/Library.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (hide annotations) (vendor branch)
Fri Sep 8 18:17:50 2000 UTC (23 years, 6 months ago) by dpavlin
Branch: DbP, MAIN
CVS Tags: r0, HEAD
Changes since 1.1: +0 -0 lines
File MIME type: text/plain
initial import

1 dpavlin 1.1 #!/usr/bin/perl -w
2    
3     #*****************************************************************************
4     # Copyright (C) 1993-2000, FS Consulting Inc. All rights reserved *
5     # *
6     # *
7     # This notice is intended as a precaution against inadvertent publication *
8     # and does not constitute an admission or acknowledgement that publication *
9     # has occurred or constitute a waiver of confidentiality. *
10     # *
11     # This software is the proprietary and confidential property *
12     # of FS Consulting, Inc. *
13     #*****************************************************************************
14    
15     #--------------------------------------------------------------------------
16     #
17     # Author: Francois Schiettecatte (FS Consulting, Inc.)
18     # Creation Date: 4/9/98
19    
20    
21     #--------------------------------------------------------------------------
22     #
23     # Description:
24     #
25     # This script implements the search interface into the search engine. We
26     # interface with the search engine using the Direct protocol.
27     #
28    
29    
30     #--------------------------------------------------------------------------
31     #
32     # Modification Log
33     #
34     # Date:
35     # Author:
36     # Organization:
37     # Email:
38     # Description:
39     #
40     #
41     # Date: 4/9/98
42     # Author: Francois Schiettecatte
43     # Organization: FS Consulting, Inc.
44     # Email: francois@fsconsult.com
45     # Description: First cut.
46    
47    
48     #--------------------------------------------------------------------------
49     #
50     # Pragmatic modules
51     #
52    
53     use strict;
54    
55    
56     #--------------------------------------------------------------------------
57     #
58     # Required packages
59     #
60    
61     # Load the libraries
62     require "flush.pl";
63    
64    
65    
66     # For time conversion
67     use Time::Local;
68    
69    
70     #--------------------------------------------------------------------------
71     #
72     # Environment variables
73     #
74    
75     # Set up the environment so that we can find the external applications we need
76     $ENV{'PATH'} = "/bin:/usr/bin:/sbin:/usr/sbin:/usr/ucb:/usr/etc";
77     $ENV{'LD_LIBRARY_PATH'} = "/usr/lib";
78    
79    
80    
81     #--------------------------------------------------------------------------
82     #
83     # Constants
84     #
85    
86    
87     # Month name list
88     @main::MonthNames = (
89     'January',
90     'February',
91     'March',
92     'April',
93     'May',
94     'June',
95     'July',
96     'August',
97     'September',
98     'October',
99     'November',
100     'December'
101     );
102    
103     # Date suffix list
104     @main::DateSuffixes = (
105     'th',
106     'st',
107     'nd',
108     'rd',
109     'th',
110     'th',
111     'th',
112     'th',
113     'th',
114     'th'
115     );
116    
117    
118     # XML Header tag
119     $main::XMLHeader = "<?xml version=\"1.0\" ?>";
120    
121    
122     #--------------------------------------------------------------------------
123     #
124     # Function: sGetAnsiDateFromTime()
125     #
126     # Purpose: This function returns an ANSI date from the passed time,
127     # if the time is not passed, then the current time will be
128     # used.
129     #
130     # Called by:
131     #
132     # Parameters: $Time time
133     #
134     # Global Variables: none
135     #
136     # Returns: ANSI date
137     #
138     sub sGetAnsiDateFromTime {
139    
140     my ($Time) = @_;
141     my ($AnsiDate, $Mday, $Mon, $Year);
142    
143    
144     # Get the current time if the parameter was undefined
145     if ( !defined($Time) ) {
146     $Time = time();
147     }
148    
149     # Create the ANSI format date
150     ($Mday, $Mon, $Year) = (localtime($Time))[3..5];
151     $AnsiDate = sprintf("%d%02d%02d", $Year + 1900, $Mon + 1, $Mday);
152    
153     return ($AnsiDate);
154    
155     }
156    
157    
158    
159    
160     #--------------------------------------------------------------------------
161     #
162     # Function: sGetAnsiTimeFromTime()
163     #
164     # Purpose: This function returns an ANSI time from the passed time,
165     # if the time is not passed, then the current time will be
166     # used.
167     #
168     # Called by:
169     #
170     # Parameters: $Time time
171     #
172     # Global Variables: none
173     #
174     # Returns: ANSI time
175     #
176     sub sGetAnsiTimeFromTime {
177    
178     my ($Time) = @_;
179     my ($AnsiTime, $Sec, $Min, $Hour);
180    
181    
182     # Get the current time if the parameter was undefined
183     if ( !defined($Time) ) {
184     $Time = time();
185     }
186    
187     # Create the ANSI format date
188     ($Sec, $Min, $Hour) = (localtime($Time))[0..2];
189     $AnsiTime = sprintf("%02d%02d%02d", $Hour, $Min, $Sec);
190    
191     return ($AnsiTime);
192    
193     }
194    
195    
196    
197    
198     #--------------------------------------------------------------------------
199     #
200     # Function: tSubstractFromTime()
201     #
202     # Purpose: This function substracts years, month or days off a
203     # time and returns the new time.
204     #
205     # Called by:
206     #
207     # Parameters: $Time time
208     # $Years years to remove
209     # $Months months to remove
210     # $Days days to remove
211     #
212     #
213     # Global Variables: none
214     #
215     # Returns: ANSI time
216     #
217     sub tSubstractFromTime {
218    
219     my ($Time, $Years, $Months, $Days) = @_;
220     my ($AnsiDate, $Mday, $Mon, $Year);
221    
222    
223     # Get the current time if the parameter was undefined
224     if ( !defined($Time) ) {
225     $Time = time();
226     }
227    
228    
229     # Substract the days if specified
230     if ( defined($Days) ) {
231     $Time -= (60 * 60 * 24 * $Days);
232     }
233    
234    
235     # Need to convert the date to a time if we are
236     # substracting years or months.
237     if ( defined($Months) || defined($Years) ) {
238    
239     # Convert the time to a date
240     ($Mday, $Mon, $Year) = (localtime($Time))[3..5];
241    
242     # Substract months
243     if ( defined($Months) ) {
244    
245     # More than 12 months, adjust the year
246     if ( $Months >= 12 ) {
247     $Year -= abs($Months / 12);
248     $Months = $Months % 12;
249     }
250    
251     # Deal with wrapping around the end of a year
252     if ( $Months > $Mon ) {
253     $Year--;
254     $Months = -(12 - $Months);
255     }
256    
257     # Substract the months
258     $Mon -= $Months;
259     }
260    
261     # Substract the years
262     if ( defined($Years) ) {
263     $Year -= $Years;
264     }
265    
266     # Convert the date back to a time
267     $Time = timelocal(0, 0, 0, $Mday, $Mon, $Year);
268     }
269    
270     return ($Time);
271    
272     }
273    
274    
275    
276    
277    
278     #--------------------------------------------------------------------------
279     #
280     # Function: sGetPrintableDateFromTime()
281     #
282     # Purpose: This function returns a printable date from the passed time,
283     # if the time is not passed, then the current time will be
284     # used.
285     #
286     # Called by:
287     #
288     # Parameters: $Time time
289     #
290     # Global Variables: @main::MonthNames
291     #
292     # Returns: printable date
293     #
294     sub sGetPrintableDateFromTime {
295    
296     my ($Time) = @_;
297     my ($AnsiDate, $AnsiTime, $PrintableDate);
298     my ($Year, $Month, $Day, $Hour, $Min, $Sec);
299    
300    
301     # Get the current time if the parameter was undefined
302     if ( !defined($Time) ) {
303     $Time = time();
304     }
305    
306    
307     # Get the ANSI date and time
308     $AnsiDate = &sGetAnsiDateFromTime($Time);
309     $AnsiTime = &sGetAnsiTimeFromTime($Time);
310    
311    
312     # Break up the ANSI date and time into its components
313     $Year = substr($AnsiDate, 0, 4);
314     $Month = substr($AnsiDate, 4, 2);
315     $Day = substr($AnsiDate, 6, 2);
316     $Hour = substr($AnsiTime, 0, 2);
317     $Min = substr($AnsiTime, 2, 2);
318     $Sec = substr($AnsiTime, 4, 2);
319    
320     # Create the printable date
321     if ( ($Day > 10) && ($Day < 20) ) {
322     $PrintableDate = sprintf("%s %d%s, %d (%02d:%02d:%02d)", $main::MonthNames[$Month - 1], $Day, $main::DateSuffixes[0], $Year, $Hour, $Min, $Sec);
323     }
324     else {
325     $PrintableDate = sprintf("%s %d%s, %d (%02d:%02d:%02d)", $main::MonthNames[$Month - 1], $Day, $main::DateSuffixes[$Day % 10], $Year, $Hour, $Min, $Sec);
326     }
327    
328     return ($PrintableDate);
329    
330     }
331    
332    
333    
334     #--------------------------------------------------------------------------
335     #
336     # Function: shGetHashFromXMLFile()
337     #
338     # Purpose: This function reads the XML file and returns its header
339     # and its contents in a hash table
340     #
341     # Called by:
342     #
343     # Parameters: $FilePath full path to a file name
344     #
345     # Global Variables: none
346     #
347     # Returns: the header and the hash table contents
348     #
349     sub shGetHashFromXMLFile {
350    
351     my ($FilePath) = @_;
352    
353     my ($ObjectTag, %Content);
354     my ($Tag, $TagValue);
355    
356    
357     # Check the values that we got passed
358     if ( !defined($FilePath) ) {
359     return (undef);
360     }
361    
362     # Get the symbol if the file is there
363     if ( !open(XML_FILE, "$FilePath") ) {
364     return (undef);
365     }
366    
367    
368    
369     # Read the XML header
370     while (<XML_FILE>) {
371     if ( substr($_, 0, length($main::XMLHeader)) ne $main::XMLHeader ) {
372     goto bailFromshGetHashFromXMLFile;
373     }
374     last;
375     }
376    
377    
378     # Read the XML object tag
379     while (<XML_FILE>) {
380     if ( $_ =~ /^\<(\S*)\>/ ) {
381     $ObjectTag = $1;
382     }
383     last;
384     }
385    
386    
387     # Loop over the file
388     while (<XML_FILE>) {
389    
390     # Is this a symbol?
391     if ( $_ =~ /\<(\w*)\>(.*\n*)/ ) {
392    
393     # It is, so we extract it
394     $Tag = $1;
395     $TagValue = $2;
396    
397     # Did we get it all?
398     if ( $TagValue =~ /(.*)\<\/(\w*)\>/ ) {
399     $TagValue = $1;
400     }
401     else {
402    
403     # We did not get the whole symbol value, it is multi-line,
404     # so we keep reading the file until we get it all
405     while (<XML_FILE>) {
406    
407     $TagValue .= $_;
408    
409     # Did we get it all?
410     if ( $TagValue =~ m/(.*\n*)\<\/(\w*)\>/s ) {
411    
412     # We got the whole symbol so we exit
413     $TagValue = $1;
414     last;
415     }
416     }
417     }
418    
419     # Add it to the hash table
420     $Content{$Tag} = $TagValue;
421    
422     }
423     else {
424     # Dont know what this is
425     }
426     }
427    
428     # Bail label
429     bailFromshGetHashFromXMLFile:
430    
431    
432     close(XML_FILE);
433    
434    
435     # And return
436     return ($ObjectTag, %Content);
437    
438     }
439    
440    
441    
442    
443    
444    
445     #--------------------------------------------------------------------------
446     #
447     # Function: iSaveXMLFileFromHash()
448     #
449     # Purpose: This function write the SML file from the passed header
450     # and hash file
451     #
452     # Called by: many
453     #
454     # Parameters: $FilePath full path to a file name
455     # $Header header string
456     # %Content content hash table
457     #
458     # Global Variables: none
459     #
460     # Returns: Boolean status
461     #
462     sub iSaveXMLFileFromHash {
463    
464     my ($FilePath, $Header, %Content) = @_;
465     my ($Tag);
466    
467    
468     # Create the XML file
469     if ( ! open(XML_FILE, ">$FilePath") ) {
470     # Failed to create the file, so we return an error
471     return (0);
472     }
473    
474     # Write out the XML header
475     print(XML_FILE "$main::XMLHeader\n");
476    
477     # Write out the XML object name open tag
478     print(XML_FILE "<$Header>\n");
479    
480     # Write out the keys & contents of the hash table
481     foreach $Tag ( sort( keys(%Content) ) ) {
482     if ( defined($Content{$Tag}) && ($Content{$Tag} ne "") ) {
483     print(XML_FILE "<$Tag>$Content{$Tag}</$Tag>\n");
484     }
485     }
486    
487     # Write out the XML object name close tag
488     print(XML_FILE "</$Header>\n");
489    
490     # Close the file
491     close(XML_FILE);
492    
493     # Secure the file
494     chmod(0600, $FilePath);
495    
496     return (1);
497    
498     }
499    
500    
501    
502    
503    
504    
505    
506    
507    
508    
509     #--------------------------------------------------------------------------
510     #
511     # Function: sGetObjectTagFromXMLFile()
512     #
513     # Purpose: This function extracts the XML object tag from the XML file
514     # specified in $FilePath
515     #
516     # Called by:
517     #
518     # Parameters: $FilePath full path to a file name
519     #
520     # Global Variables: none
521     #
522     # Returns: the XML object tag that was extracted from the file, undef on error
523     #
524     sub sGetObjectTagFromXMLFile {
525    
526     my ($FilePath) = @_;
527     my ($ObjectTag);
528    
529    
530     # Check the values that we got passed
531     if ( !defined($FilePath) ) {
532     return (undef);
533     }
534    
535     # Get the symbol if the file is there
536     if ( !open(XML_FILE, "$FilePath") ) {
537     return (undef);
538     }
539    
540    
541     # Read the XML header
542     while (<XML_FILE>) {
543     if ( substr($_, 0, length($main::XMLHeader)) ne $main::XMLHeader ) {
544     goto bailFromsGetObjectTagFromXMLFile;
545     }
546     last;
547     }
548    
549    
550     # Read the XML object tag
551     while (<XML_FILE>) {
552     if ( $_ =~ /^\<(\S*)\>/ ) {
553     $ObjectTag = $1;
554     }
555     last;
556     }
557    
558    
559     # Bail label
560     bailFromsGetObjectTagFromXMLFile:
561    
562     close(XML_FILE);
563    
564     # And return
565     return ($ObjectTag);
566    
567     }
568    
569    
570    
571    
572    
573    
574    
575     #--------------------------------------------------------------------------
576     #
577     # Function: sGetTagValueFromXMLFile()
578     #
579     # Purpose: This function extracts a value from
580     # the XML file specified in $FilePath
581     #
582     # The symbol is specified in $Tag.
583     #
584     # Called by:
585     #
586     # Parameters: $FilePath full path to a file name
587     # $Tag symbol name to extract
588     #
589     # Global Variables: none
590     #
591     # Returns: the string that was extracted from the file, undef on error
592     #
593     sub sGetTagValueFromXMLFile {
594    
595     my ($FilePath, $Tag) = @_;
596     my ($ObjectTag, $TagValue);
597    
598    
599     # Check the values that we got passed
600     if ( !defined($FilePath) ) {
601     return (undef);
602     }
603    
604     if ( !defined($Tag) ) {
605     return (undef);
606     }
607    
608     # Get the symbol if the file is there
609     if ( !open(XML_FILE, "$FilePath") ) {
610     return (undef);
611     }
612    
613    
614     # Read the XML header
615     while (<XML_FILE>) {
616     if ( substr($_, 0, length($main::XMLHeader)) ne $main::XMLHeader ) {
617     goto bailFromsReadSymbolFromXMLFile;
618     }
619     last;
620     }
621    
622    
623     # Read the XML object tag
624     while (<XML_FILE>) {
625     if ( $_ =~ /^\<(\S*)\>/ ) {
626     $ObjectTag = $1;
627     }
628     last;
629     }
630    
631    
632     # Loop over each entry in the file
633     while (<XML_FILE>) {
634    
635     # Is this the symbol?
636     if ( ($_ =~ /\<(\w*)\>(.*\n*)/) && ($1 eq $Tag) ) {
637    
638     # It is, so we extract it
639     $TagValue = $2;
640    
641     # Did we get it all?
642     if ( ($TagValue =~ /(.*)\<\/(\w*)\>/) && ($2 eq $Tag) ) {
643     $TagValue = $1;
644     }
645     else {
646    
647     # We did not get the whole symbol value, it is multi-line,
648     # so we keep reading the file until we get it all
649     while (<XML_FILE>) {
650    
651     $TagValue .= $_;
652    
653     # Did we get it all?
654     if ( ($TagValue =~ m/(.*\n*)\<\/(\w*)\>/s) && ($2 eq $Tag) ) {
655     # We got the whole symbol so we exit
656     $TagValue = $1;
657     last;
658     }
659     }
660     }
661    
662     last;
663     }
664     }
665    
666    
667     # Bail label
668     bailFromsReadSymbolFromXMLFile:
669    
670     close(XML_FILE);
671    
672     # And return
673     return ($TagValue);
674    
675     }
676    
677    
678    
679    
680    
681    
682     #--------------------------------------------------------------------------
683     #
684     # Function: vPrintFileContent()
685     #
686     # Purpose: This function prints out the connects of the passed file
687     # name to STDOUT
688     #
689     # Called by: main
690     #
691     # Parameters: $FileName file name
692     #
693     # Global Variables: none
694     #
695     # Returns: void
696     #
697    
698     sub vPrintFileContent {
699    
700     my ($FileName) = @_ ;
701    
702    
703     if ( ! defined($FileName) ) {
704     return;
705     }
706    
707     if ( ! open (FILE, $FileName) ) {
708     return;
709     }
710    
711     {
712     # Override the line-by-line reading of files and print the entire file
713     local $/ = undef;
714     printf("%s", <FILE>);
715     }
716    
717     close (FILE);
718    
719     return;
720     }
721    
722    
723    
724     #--------------------------------------------------------------------------
725     #
726     # Function: bhReadConfigurationFile()
727     #
728     # Purpose: This function reads the configuration file and places it in the
729     # hash table global, note that the hash table is not cleared before
730     # we start to add kay/value pairs to it.
731     #
732     # Any line which starts with a '#' or is empty will be skipped.
733     #
734     # An error will be generated if we try to redefine a value for a
735     # key that has already been defined.
736     #
737     # Called by:
738     #
739     # Parameters: $ConfigurationFilePath configuration file path
740     #
741     # Global Variables:
742     #
743     # Returns: Boolean status and the hash table
744     #
745     sub bhReadConfigurationFile {
746    
747    
748     my ($ConfigurationFilePath) = @_;
749    
750     my (%ConfigurationData, $Key, $Value, $Status);
751    
752    
753     # Init the status
754     $Status = 1;
755    
756    
757     &vLog("\nReading configuration file: $ConfigurationFilePath.\n");
758    
759    
760     # Check that the configuration file is there
761     if ( ! -f $ConfigurationFilePath ) {
762     &vLog("Error - cannot find configuration file: '$ConfigurationFilePath'.\n");
763     return (0);
764     }
765    
766    
767     # Check that the configuration file can be read
768     if ( ! -r $ConfigurationFilePath ) {
769     &vLog("Error - cannot read configuration file: '$ConfigurationFilePath'.\n");
770     return (0);
771     }
772    
773    
774     # Open the database configuration file
775     if ( ! open(CONFIGURATION_FILE, "$ConfigurationFilePath") ) {
776     &vLog("Error - could not open configuration file: '$ConfigurationFilePath'.\n");
777     return (0);
778     }
779    
780    
781     # Read in each line in the file, ignore empty
782     # lines and lines which start with a '#'
783     while (<CONFIGURATION_FILE>) {
784    
785     chop $_;
786    
787     # Check to see if this line is empty or is a comment, and skip them
788     if ( (length($_) == 0) || (substr($_, 0, 1) eq "#") ) {
789     next;
790     }
791    
792     # Split the configuration string into a set of key/value pairs
793     ($Key, $Value) = split(/=/, $_);
794    
795     # Only add values which are defined
796     if ( defined($Value) && ($Value ne "") ) {
797    
798     # Add the key/value pairs to the hash table
799     if ( defined($ConfigurationData{$Key}) ) {
800     # Fail if the value for this key is already defined
801     &vLog("Error - value for: '$Key', is already defined as: '$ConfigurationData{$Key}', tried to redefine it to: '$Value'.\n");
802     close (CONFIGURATION_FILE);
803     $Status = 0;
804     }
805     else {
806     # Add the value for this key
807     $ConfigurationData{$Key} = $Value;
808     }
809     }
810    
811     }
812     close(CONFIGURATION_FILE);
813    
814     &vLog("Finished reading configuration file.\n");
815    
816     return ($Status, %ConfigurationData);
817    
818     }
819    
820    
821    
822    
823    
824    
825    
826     #--------------------------------------------------------------------------
827     #
828     # Function: bCheckMinimalConfiguration()
829     #
830     # Purpose: This function checks that the minimal configuration
831     # required has been specified. Note that we dont check
832     # for the validity of the values, we just check that
833     # they are defined.
834     #
835     # Called by: main()
836     #
837     # Parameters: $ConfigurationData reference to a configuration data hash table
838     # $RequiredSetting reference to a required settings list
839     #
840     # Global Variables:
841     #
842     # Returns: Boolean status
843     #
844     sub bCheckMinimalConfiguration {
845    
846     my ($ConfigurationData, $RequiredSetting) = @_;
847    
848     my ($RequiredSettingEntry, $Status);
849    
850    
851     # Init the status
852     $Status = 1;
853    
854    
855     &vLog("\nChecking required configuration settings.\n");
856    
857     # Process the settings if there is a settings list
858     if ( @{$RequiredSetting} ) {
859    
860     # Loop over each file in the list
861     foreach $RequiredSettingEntry ( @{$RequiredSetting} ) {
862    
863     # Check that the configuration setting is defined and can be accessed
864     if ( ! defined(${$ConfigurationData}{$RequiredSettingEntry}) ) {
865     &vLog("Error - required configuration setting: '$RequiredSettingEntry' was not specified.\n");
866     $Status = 0;
867     }
868     }
869     }
870    
871     &vLog("Finished checking required configuration settings.\n");
872    
873    
874     return ($Status);
875    
876     }
877    
878    
879    
880    
881    
882     #--------------------------------------------------------------------------
883     #
884     # Function: bSetConfigurationDefaults()
885     #
886     # Purpose: This functions sets any confguration defaults in the configuration
887     # file that were not set in the configuration file.
888     #
889     # Called by:
890     #
891     # Parameters: $ConfigurationData reference to a configuration data hash table
892     # $DefaultSettings reference to a default settings hash table
893     #
894     # Global Variables: none
895     #
896     # Returns: Boolean status
897     #
898     sub bSetConfigurationDefaults {
899    
900     my ($ConfigurationData, $DefaultSettings) = @_;
901    
902     my ($DefaultSettingEntry, $Status);
903    
904    
905     # Init the status
906     $Status = 1;
907    
908    
909     # Process the settings if there is a settings list
910     if ( %{$DefaultSettings} ) {
911    
912     # Loop over each file in the list
913     foreach $DefaultSettingEntry ( keys (%{$DefaultSettings}) ) {
914    
915     # Set the configuration setting if it is not set
916     if ( ! defined(${$ConfigurationData}{$DefaultSettingEntry}) ) {
917     ${$ConfigurationData}{$DefaultSettingEntry} = ${$DefaultSettings}{$DefaultSettingEntry};
918     }
919     }
920     }
921    
922     return ($Status);
923     }
924    
925    
926    
927    
928    
929     #--------------------------------------------------------------------------
930     #
931     # Function: sCleanSetting()
932     #
933     # Purpose: This function cleans a setting string/path.
934     #
935     # Called by:
936     #
937     # Parameters: $SettingName the setting name - for debug output
938     # $Setting the setting to clean
939     # $SettingPrefix the setting prefix
940     #
941     # Global Variables: none
942     #
943     # Returns:
944     #
945     sub sCleanSetting {
946    
947     my ($SettingName, $Setting, $SettingPrefix) = @_;
948    
949     my (@ItemEntries, $ItemEntry, @NewItemEntries);
950    
951    
952     # dont get caught on stupid errors
953     if ( !defined($Setting) ) {
954     return ($Setting);
955     }
956    
957    
958     # Split the variable
959     @ItemEntries = split(/,/, $Setting);
960    
961     # Loop over each entry, checking them
962     foreach $ItemEntry ( @ItemEntries ) {
963    
964     # Check for leading/trailing spaces
965     if ( ($ItemEntry =~ /^\s+(\S*)/) || ($ItemEntry =~ /(\S*)\s+$/) || ($ItemEntry =~ /^\s+(\S*)\s+$/) ) {
966     &vLog("Warning - configuration setting: '$SettingName', value: '$ItemEntry' has leading/trailing spaces which should be removed.\n");
967     $ItemEntry = $1;
968     }
969    
970     # Check for trailing '/'
971     if ( $ItemEntry =~ /(^\S*)\/$/ ) {
972     &vLog("Warning - configuration setting: '$SettingName', value: '$ItemEntry' has a trailing slash which should be removed.\n");
973     $ItemEntry = $1;
974     }
975    
976    
977     # Add the prefix if needed
978     if ( defined($SettingPrefix) && (substr($ItemEntry, 0, 1) ne "/") ) {
979     $ItemEntry = $SettingPrefix. "/" . $ItemEntry;
980     }
981    
982     # Add the cleaned entry to the new list
983     push @NewItemEntries, $ItemEntry;
984     }
985    
986    
987     # Return the cleaned entries having just joined them with commas
988     return ( join(",", @NewItemEntries) );
989    
990     }
991    
992    
993    
994    
995    
996    
997    
998    
999     #--------------------------------------------------------------------------
1000     #
1001     # Function: iRolloverLog()
1002     #
1003     # Purpose: This functions sets any confguration defaults in the
1004     # configuration file that were not set in the configuration
1005     # file.
1006     #
1007     # Called by:
1008     #
1009     # Parameters: $LogFileName log file name
1010     # $Rollover number of files to roll over
1011     #
1012     # Global Variables: none
1013     #
1014     # Returns: Boolean status
1015     #
1016     sub iRolloverLog {
1017    
1018     my ($LogFileName, $Rollover) = @_;
1019     my ($I, $NewFileName, $OldFileName, $Status);
1020    
1021    
1022     # Init the status
1023     $Status = 0;
1024    
1025    
1026     # Roll over the log file if the value is greater than 0
1027     if ( $Rollover > 0 ) {
1028    
1029     # Remove the last file if it exists
1030     $NewFileName = $LogFileName . "." . $Rollover;
1031     if ( -f $NewFileName ) {
1032     unlink($NewFileName);
1033     }
1034    
1035    
1036     # Roll the intermediate files over
1037     for ( $I = ($Rollover - 1); $I >= 0; $I-- ) {
1038    
1039     # Create the new file name
1040     $NewFileName = $LogFileName . "." . ($I + 1);
1041    
1042     # Create the old file name, note that file 0 is the original log file
1043     if ( $I > 0 ) {
1044     $OldFileName = $LogFileName . "." . $I;
1045     }
1046     else {
1047     $OldFileName = $LogFileName ;
1048     }
1049    
1050     # Move the file if it exists
1051     if ( -f $OldFileName ) {
1052     if ( ! rename ($OldFileName, $NewFileName) ) {
1053     &vLog("Error - failed rollover log files: '$OldFileName', to: '$NewFileName', system error: $!.\n");
1054     $Status = -1;
1055     }
1056     }
1057     }
1058     }
1059    
1060    
1061     return ($Status);
1062    
1063     }
1064    
1065    
1066    
1067    
1068    
1069    
1070     #--------------------------------------------------------------------------
1071     #
1072     # Function: lEncodeURLData()
1073     #
1074     # Purpose: This function encodes the passed URL data.
1075     #
1076     # Called by:
1077     #
1078     # Parameters: @ItemList item list (could be a single item)
1079     #
1080     # Global Variables: none
1081     #
1082     # Returns: the encoded item/list
1083     #
1084     sub lEncodeURLData {
1085    
1086     my (@ItemList) = @_;
1087     my ($ItemEntry, @NewItemList);
1088    
1089    
1090     # Dont get caught on stupid errors
1091     if ( !@ItemList ) {
1092     return (undef);
1093     }
1094    
1095    
1096     # Encode each item in the list
1097     foreach $ItemEntry ( @ItemList ) {
1098     if ( defined($ItemEntry) ) {
1099     $ItemEntry =~ s/([%?&+"<>=])/sprintf("%%%x", ord($1))/eg;
1100     $ItemEntry =~ tr/ /\+/;
1101     push @NewItemList, $ItemEntry;
1102     }
1103     }
1104    
1105    
1106     # Return the item or the list
1107     return ((scalar(@NewItemList) > 1) ? @NewItemList : $NewItemList[0]);
1108    
1109     }
1110    
1111    
1112    
1113    
1114     #--------------------------------------------------------------------------
1115     #
1116     # Function: lDecodeURLData()
1117     #
1118     # Purpose: This function encodes the passed URL data.
1119     #
1120     # Called by:
1121     #
1122     # Parameters: @ItemList item list (could be a single item)
1123     #
1124     # Global Variables: none
1125     #
1126     # Returns: the encoded item/list
1127     #
1128     sub lDecodeURLData {
1129    
1130     my (@ItemList) = @_;
1131     my ($ItemEntry, @NewItemList);
1132    
1133    
1134     # Dont get caught on stupid errors
1135     if ( !@ItemList ) {
1136     return (undef);
1137     }
1138    
1139    
1140     # Decode each item in the list
1141     foreach $ItemEntry ( @ItemList ) {
1142     if ( defined($ItemEntry) ) {
1143     $ItemEntry =~ tr/+/ /;
1144     $ItemEntry =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
1145     push @NewItemList, $ItemEntry;
1146     }
1147     }
1148    
1149     # Return the item or the list
1150     return ((scalar(@NewItemList) > 1) ? @NewItemList : $NewItemList[0]);
1151    
1152     }
1153    
1154    
1155    
1156    
1157     #--------------------------------------------------------------------------
1158     #
1159     # Function: hParseURLIntoHashTable()
1160     #
1161     # Purpose: This function parses the URL and places it in a
1162     # hash table that is returned . The form data is first
1163     # looked for in the passed search search, if that is not
1164     # available, then we look to the usual CGI suspects for data.
1165     #
1166     # Called by:
1167     #
1168     # Parameters: $URLString URL string
1169     #
1170     # Global Variables: none
1171     #
1172     # Returns: a hash table, or undefined on error
1173     #
1174     sub hParseURLIntoHashTable {
1175    
1176     my ($URLString) = @_;
1177     my (%LocalHash, @KeyValuePairs, $KeyValuePair, $Key, $Value, %Value);
1178    
1179    
1180     # Check that we got a query string, no point in parsing it out if we didnt
1181     if ( !(defined($URLString) && ($URLString ne "")) ) {
1182     return (%LocalHash);
1183     }
1184    
1185    
1186     # Split the query string into a set of key/value pairs
1187     @KeyValuePairs = split(/&/, $URLString);
1188    
1189     # Loop over each key/value pair
1190     foreach $KeyValuePair ( @KeyValuePairs ) {
1191    
1192     # Split the key/value pairs
1193     ($Key, $Value) = split(/=/, $KeyValuePair);
1194    
1195     if ( defined($Value) && ($Value ne "") ) {
1196    
1197     $Value = &lDecodeURLData($Value);
1198     $Key = &lDecodeURLData($Key);
1199    
1200     # Add the key/value pairs to the hash table
1201     if ( defined($LocalHash{$Key}) ) {
1202     $LocalHash{$Key} = join ("\0", $LocalHash{$Key}, $Value);
1203     }
1204     else {
1205     $LocalHash{$Key} = $Value;
1206     }
1207     }
1208     }
1209    
1210     return (%LocalHash);
1211     }
1212    
1213    
1214    
1215    
1216     #--------------------------------------------------------------------------

  ViewVC Help
Powered by ViewVC 1.1.26