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 th e 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 |
#-------------------------------------------------------------------------- |