/[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

Contents of /search/Library.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (vendor branch)
Fri Sep 8 18:17:50 2000 UTC (18 years, 8 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 #!/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