[23583] in Perl-Users-Digest
Perl-Users Digest, Issue: 5790 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Thu Nov 13 00:05:58 2003
Date: Wed, 12 Nov 2003 21:05:06 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Wed, 12 Nov 2003 Volume: 10 Number: 5790
Today's topics:
Re: "tree" view of directory <tore@aursand.no>
a Post-script to flocking question <spammerswelcome@aol.com>
Re: DBD-Oracle-1.14 <jwillmore@remove.adelphia.net>
Re: fetchall_arrayref into bind_param_array <jwillmore@remove.adelphia.net>
Re: Newbie Question about Hashes <tore@aursand.no>
Re: Newbie Question about Hashes (Tad McClellan)
Re: Newbie wants to flock <emschwar@pobox.com>
Re: Newbie wants to flock <spammerswelcome@aol.com>
Re: perl script <tore@aursand.no>
Re: problem with if-else assignment in text database <invalid@invalid.com.invalid>
Re: Problem with IO::Socket::INET and pop <asu1@c-o-r-n-e-l-l.edu>
Re: REQUEST_URI unavailable <jwillmore@remove.adelphia.net>
Re: Sorting a multi-dimensional hash (Tad McClellan)
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Thu, 13 Nov 2003 04:19:47 +0100
From: Tore Aursand <tore@aursand.no>
Subject: Re: "tree" view of directory
Message-Id: <pan.2003.11.13.02.26.34.10678@aursand.no>
On Wed, 12 Nov 2003 13:20:32 -0600, Tad McClellan wrote:
> I snatched this one when I saw Tushar Samant post it here years ago:
> find . -print | sed -e 's,[^/]*/\([^/]*\)$,`--\1,' -e 's,[^/]*/,| ,g'
And this Tushar guy has ever since tried to enhance this one-liner with
bells and whistles?
Jeez. :-)
--
Tore Aursand <tore@aursand.no>
------------------------------
Date: Thu, 13 Nov 2003 00:43:46 -0000
From: "Dick Rosser" <spammerswelcome@aol.com>
Subject: a Post-script to flocking question
Message-Id: <YhDsb.408$535.907942@newsfep1-win.server.ntli.net>
Sorry, I also meant to ask if there is any
error trapping with flock. If a second person
accesses the database befor the first persons lock
is in place, is the database corrupted. How does one
work around this?
Regards
Dick Rosser
webmasterone@kidwatch-uk,net
------------------------------
Date: Thu, 13 Nov 2003 02:16:43 GMT
From: James Willmore <jwillmore@remove.adelphia.net>
Subject: Re: DBD-Oracle-1.14
Message-Id: <20031112211421.0c48da1e.jwillmore@remove.adelphia.net>
On 12 Nov 2003 06:20:20 -0800
pico72@libero.it (diego) wrote:
<snip>
> >>> Remember to actually *READ* the README file!
> Especially if you have any problems.
Clue number 1
<snip>
> *********************************************************
> I can't find the header files I need in your Oracle installation.
> You probably need to install some more Oracle components. I'll keep
> going, but the compile will probably fail. See README.clients for
> more information.
>
> *********************************************************
Clue number 2
>
> Found oci directory
> Using OCI directory 'oci'
> Found oci/lib/MSVC/oramts.lib library
> *** Warning: Colons in the current directory path
> (C:/perl/DBDOracle114) may cause problems
> Unable to find required Oracle OCI files for the build. Please
> check That you have your OCI installed in your oracle home
> (C:/oracle/ora9) Directory and that it has the following files
> (and probably more):
>
> C:/oracle/ora92\oci\include\oratypes.h
> C:/oracle/ora92\oci\lib\MSVC\.lib
>
> Please install OCI or send comments back to dbi-users@perl.org
> If you have an OCI directory other than oci.
>
> At Makefile.pl line 263
Clue number 3
Hummm ... seems like you have some work cut out for you.
Let's start with clue number 1 - did you *read* the README file? If
so, what did you not understand? Was it clear direction on what to do
to install the module? If it was unclear, waht was unclear?
Clue number 2 states that the Makefile.PL can *not* find the Oracle
header files. Do you have them on your system? Did you *read* the
README.clients file? Did it apply to you?
Clue number 3 states that Makefile.PL is unable to find the required
Oracle OCI. It even mentions files to look for. Do you have them on
your system?
Sorry, but you need to do some of the work set forth above before
anyone can help.
--
Jim
Copyright notice: all code written by the author in this post is
released under the GPL. http://www.gnu.org/licenses/gpl.txt
for more information.
a fortune quote ...
Rules: (1) The boss is always right. (2) When the boss is
wrong, refer to rule 1.
------------------------------
Date: Thu, 13 Nov 2003 02:07:36 GMT
From: James Willmore <jwillmore@remove.adelphia.net>
Subject: Re: fetchall_arrayref into bind_param_array
Message-Id: <20031112210510.0555df96.jwillmore@remove.adelphia.net>
On 12 Nov 2003 07:19:19 -0800
oliver.gassner@web.de (Oliver G) wrote:
> Hey Folk,
> i have to do a Job to extract Data from one Database into another.
> So i thing this is a Job for Perl. I make a fetchall_arrayref then
> i insert this block into the other Database with bind_param_array.
> Now i have the Array of Arrays but i can't extract an Array of
> Column to use bind_param_array.
>
> Have any one a Idea?
>
> Any Hint welcome!
Hint: post some code.
Hint: *read* the DBI documentation (perldoc DBI)
Hint: as some of my previous posts have shown, improper use of terms
can be hazardious to your code :-)
HTH
--
Jim
Copyright notice: all code written by the author in this post is
released under the GPL. http://www.gnu.org/licenses/gpl.txt
for more information.
a fortune quote ...
There's a fine line between courage and foolishness. Too bad
it's not a fence.
------------------------------
Date: Thu, 13 Nov 2003 04:19:46 +0100
From: Tore Aursand <tore@aursand.no>
Subject: Re: Newbie Question about Hashes
Message-Id: <pan.2003.11.13.02.44.19.126240@aursand.no>
On Wed, 12 Nov 2003 16:56:12 -0800, Dennis Russo wrote:
> I have two seperate arrays that are in order, and I would like to create
> a hash table to combine the two [...]
How about this one?
for ( 0 .. $#array1 ) {
$hash{ $array1[$_] } = $array2[ $_ ];
}
You're warned, though; You should actually for() through the array with
the most elments (if the arrays have different number of elements). That
way you can set the value to something default if there's no element at
the given index in $array2.
--
Tore Aursand <tore@aursand.no>
------------------------------
Date: Wed, 12 Nov 2003 21:15:13 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: Newbie Question about Hashes
Message-Id: <slrnbr5tq1.jsv.tadmc@magna.augustmail.com>
Dennis Russo <denrusso@yahoo.com> wrote:
> I have two seperate arrays
> that are in order, and I would like to create a hash table to combine
> the two (ie $hash{arrayOne[5]}=arrayTwo[5]).
my %hash;
@hash{ @arrayOne } = @arrayTwo; # a "hash slice", see perldata.pod
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: Wed, 12 Nov 2003 19:02:48 -0700
From: Eric Schwartz <emschwar@pobox.com>
Subject: Re: Newbie wants to flock
Message-Id: <etoznf16n5j.fsf@fc.hp.com>
Ben Morrow <usenet@morrow.me.uk> writes:
> (I note you assume this is in a CGI context :)
Yes, bad Eric, no biscuit.
> You need locking whenever one process might be reading at the same
> time as another is writing. Even if there is only one update process,
> all the queries need to be locked out while that update is going on or
> the database will be in an inconsistent state and the query will
> (probably) fail. This means everyone needs to lock: readers need to
> LOCK_SH, and writers need to LOCK_EX.
I'm in a very hackish mood today. My thought was that if a search
fails, who cares-- try it again in a minute or two. True, not a very
robust way to program, but not all applications need to be robust.
-=Eric
--
Come to think of it, there are already a million monkeys on a million
typewriters, and Usenet is NOTHING like Shakespeare.
-- Blair Houghton.
------------------------------
Date: Thu, 13 Nov 2003 04:11:46 -0000
From: "Dick Rosser" <spammerswelcome@aol.com>
Subject: Re: Newbie wants to flock
Message-Id: <OvDsb.409$535.913976@newsfep1-win.server.ntli.net>
Thanks Ben
The script runs a search on a flatfile database containing
'where are you now' type messages.
The database can be accessed by both the message poster
to change/delete/update his/her posted message. (Using a
different script which does have flock implemented)
and it can also be accessed by 'searchers' looking at the
message - using this script.
At the risk of being terribly boring I have appended the script
below. Perhaps you would be kind enough to point me in the
right direction.
The script can be seen (in its infancy) running at:
http://www.missingfriends.net/search.html
enter the letters AA in the search box.
###########################
#!/usr/bin/perl
$flock = 1; #My addition#
$charset = "";
$delimitor = "\|";
$maxfields = 14;
$maxdisplay = 200;
$maxdispscreen = 5;
$match_special_chars = "no";
$database_dir = (Taken out for security)
$template_dir = (Taken out for security)
$return_url = "http://www.missingfriends.net/index.html";
$this_cgi_url = "/cgi-bin/search.cgi";
@valid = ('missingfriends.net');
$bgcolor0 = "#eeeeee";
$bgcolor1 = "#ffffff";
# Parse Form Contents
&parse_form;
if ($ENV{'REQUEST_METHOD'} ne 'POST') {
if (!$ARGV[0] && $ENV{'QUERY_STRING'} !~ /=/) {
$in{'template'} = $ENV{'QUERY_STRING'};
$in{'opendb'} = 1;
}
elsif ($ARGV[0]) {
$in{'template'} = $ARGV[0];
$in{'opendb'} = 1;
}
}
# Validate & execute command according to Action Type
unless (
$in{'opendb'} ||
($in{'action'} eq "showblank") ||
($in{'action'} eq "searchdbdisplay")) {
&error_not_a_command;
}
if ($in{'opendb'}) {&showblank}
if ($in{'action'} eq "showblank") {&showblank}
if ($in{'action'} eq "searchdbdisplay") {&search}
sub parse_form {
if ($ENV{'REQUEST_METHOD'} eq 'GET') {
@pairs = split(/&/, $ENV{'QUERY_STRING'});
}
elsif ($ENV{'REQUEST_METHOD'} eq 'POST') {
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
@pairs = split(/&/, $buffer);
}
else {
&error_form_method;
}
foreach $pair (@pairs){
if ($pair =~ /=/) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/<!--(.|\n)*-->//g;
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$in{$name} = $value;
}
}
}
sub search {
&check_url_referer;
&check_template;
if ($in{'dbname'}) {
&check_dbname;
}
else {
&error_no_db_name;
}
if ($in{'maxdispscreen'} && # 050303
($in{'maxdispscreen'} > 0 && $in{'maxdispscreen'} < 1000)) { # 050303
$maxdispscreen = $in{'maxdispscreen'}; # 050303
} # 050303
if ($in{'key2'} && ($in{'key2'} ne "")) {
$in{'key'} = $in{'key2'};
}
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
if ($mday < 10) {
$mday = "0$mday";
}
$month = ($mon + 1);
if ($month < 10) {
$month = "0$month";
}
$year = 1900 + $year;
$us_date = "$month/$mday/$year";
$europe_date = "$mday/$month/$year";
open(DB,"$database_dir$dbname");
if ($in{'keywords'}) {
if ($in{'keywords'} =~ /^[ ]+$/) {
$in{'keywords'} = "";
}
else {
if ($in{'keywords'} =~ /\&\&/i && $in{'keywords'} =~ /\+\+/i) { #
ds
&error_invalid_operator_mix; # ds
} # ds
$keywords_operator = ""; # ds
if ($in{'keywords'} =~ /\&\&/i) { # ds
$in{'keywords'} =~ s/ *\&\& */&&/i; # ds
@keywords = split(/\&\&/,$in{'keywords'}); # ds
$keywords_operator = "and"; # ds
} # ds
elsif ($in{'keywords'} =~ /\+\+/i) { # ds
$in{'keywords'} =~ s/ *\+\+ */++/i; # ds
@keywords = split(/\+\+/,$in{'keywords'}); # ds
} # ds
else { # ds
if ($in{'keywords_separator_is_comma'} =~ /^yes$/i) { # ds
@keywords = split(/ *, */,$in{'keywords'}); # ds
} # ds
else { # ds
@keywords = split(" +",$in{'keywords'}); # ds
} # ds
} # ds
}
}
&set_content_type;
open(DB,"$database_dir$dbname");
undef @MATCH;
undef @MATCHKEY;
$mct = 0;
$keymatched = 0;
while (<DB>) {
$row =$_;
chop $row;
if (!$row || $row =~ /^[ ]+$/) {next;}
# Convert all \n in $row to -RET-
$row =~ s/\n/ -RET- /g;
$row =~ s/\r//g;
if ($delimitor =~ /^\|$/i) {
@dbfld = split(/\|/,$row);
}
else {
@dbfld = split(/$delimitor/,$row);
}
$ctss=@dbfld;
if ($ctss < $xct) {
$howmany = $xct-$ctss;
$dbfld_ptr = $ctss + $howmany - 1;
while ($howmany > 0) {
$dbfld[$dbfld_ptr] = "";
$dbfld_ptr--;
$row .= $delimitor; $howmany--;
}
}
($key,$recpwd) = split(/ \| /,$dbfld[0]);
if ($in{'key'}) {
if ($in{'key'} eq $key) {
$MATCH[$mct] = $row;
$MATCHKEY[$mct] = $key;
$mct++;
$keymatched = 1;
}
}
elsif ($in{'keywords'}) {
$row1 = &replace_spc("$row");
$skip_record = 0; # ds
foreach $keyword (@keywords) {
&check_special_chars;
if (!$in{'wordmatch-keywords'} || $in{'wordmatch-keywords'} !~
/y/i) {
if ($row1 =~ /$keyword/i) {
if ($keywords_operator eq "and") { # ds
next; # ds
} # ds
else { # ds
$MATCH[$mct] = $row;
$MATCHKEY[$mct] = $key;
$mct++;
last;
} # ds
} # ds
else { # ds
if ($keywords_operator eq "and") { # ds
$skip_record = 1; # ds
last; # ds
} # ds
}
}
else {
if ($delimitor =~ /^\|$/i) {
if (($row1 =~ /\|$keyword /i) ||
($row1 =~ / $keyword /i) ||
($row1 =~ / $keyword\|/i) ||
($row1 =~ / $keyword\|$/i) ||
($row1 =~ /^$keyword /i) ||
($row1 =~ /^$keyword\|$/i) ||
($row1 =~ /^$keyword\|/i) ||
($row1 =~ /\|$keyword\|/i) ||
($row1 =~ /\|$keyword\|$/i)) {
if ($keywords_operator eq "and") { # ds
next; # ds
} # ds
else { # ds
$MATCH[$mct] = $row;
$MATCHKEY[$mct] = $key;
$mct++;
last;
} # ds
} # ds
else { # ds
if ($keywords_operator eq "and") { # ds
$skip_record = 1; # ds
last; # ds
} # ds
}
}
else {
if (($row1 =~ /$delimitor$keyword /i) ||
($row1 =~ / $keyword /i) ||
($row1 =~ / $keyword$delimitor/i) ||
($row1 =~ / $keyword$delimitor$/i) ||
($row1 =~ /^$keyword /i) ||
($row1 =~ /^$keyword$delimitor$/i) ||
($row1 =~ /^$keyword$delimitor/i) ||
($row1 =~ /$delimitor$keyword$delimitor/i) ||
($row1 =~ /$delimitor$keyword$delimitor$/i)) {
if ($keywords_operator eq "and") { # ds
next; # ds
} # ds
else { # ds
$MATCH[$mct] = $row;
$MATCHKEY[$mct] = $key;
$mct++;
last;
} # ds
} # ds
else { # ds
if ($keywords_operator eq "and") { # ds
$skip_record = 1; # ds
last; # ds
} # ds
}
}
}
}
if ($keywords_operator eq "and" && $skip_record == 0) { # ds
$MATCH[$mct] = $row; # ds
$MATCHKEY[$mct] = $key; # ds
$mct++; # ds
} # ds
}
else {
$MATCH[$mct] = $row;
$MATCHKEY[$mct] = $key;
$mct++;
}
if (($mct >= $maxdisplay) || ($keymatched == 1)) {
last;
}
# print "$row";
}
close(DB);
unless ($mct) {
¬hing_found;
}
open(FL,"$template_dir$in{'template'}");
@nfile=<FL>;
close(FL);
# More than one record matched the keys
foreach $line (@nfile) {
# For each html line
$linet=$line;
# Replace eman="fn" by its actual value
# One $line can contain only one eman="fn"
if ($linet =~ /eman=\"f.*\"/i) {
$linet =~ s/.*eman=\"//i;
$linet =~ s/\".*//;
chop($linet);
$line =~ s/eman=\"$linet\"//i;
}
if ($linet =~ /\*\*matchcnt\*\*/i) {
$line =~ s/\*\*matchcnt\*\*/$mct/i;
}
if ($linet =~ /\*\*usdate\*\*/i) {
$line =~ s/\*\*usdate\*\*/$us_date/i;
}
if ($linet =~ /\*\*europedate\*\*/i) {
$line =~ s/\*\*europedate\*\*/$europe_date/i;
}
if ($line !~ /<!--repeat-->/ && $start ne "1") {
# $line is before or after the repeat/endrepeat section
print "$line";
}
elsif ($line !~ /<!--repeat-->/ && $start==1) {
# $line is between repeat and endrepeat (including endrepeat)
$repeated .= $line;
}
else {
# $line is repeat line
$start=1;
}
if ($line =~ /<!--endrepeat-->/) {
# $line is endrepeat, set $start ne 1
undef $start;
$itemno = 0;
if ($in{'nextstart'}) {
$nextst = $in{'nextstart'};
$nextend = $nextst + $maxdispscreen - 1;
}
else {
$nextst = 1;
$nextend = $maxdispscreen;
}
# Now sort all the matched records
$oddeven = 0;
$match_reccnt = 0;
foreach $match_rec (@MATCH) { # For each matched record
$key = $MATCHKEY[$match_reccnt];
$match_reccnt++;
$itemno++;
if (($itemno >= $nextst) && ($itemno <= $nextend)) {
if ($delimitor =~ /^\|$/i) {
@fs = split(/\|/,$match_rec);
}
else {
@fs = split(/$delimitor/,$match_rec);
}
($key,$pwd) = split(/ \| /,$fs[0]);
if ($in{'url_flds'}) { # 050402
undef @urlflds; # 050402
@urlflds = split (/,/,$in{'url_flds'}); # 050402
foreach $urlfld (@urlflds) { # 050402
$urlfld =~ s/^f//i; # 050402
$urlfld = $urlfld - 1; # 050402
if ($fs[$urlfld] && $fs[$urlfld] !~ /^http:\/\//i) { #
050402
$fs[$urlfld] = "http://" . $fs[$urlfld]; # 050402
} # 050402
} # 050402
} # 050402
# Assign field values in Matched Record to $TMP[f1,f2,..]
$ctfs2=1;
$fs2="f1";
foreach $val (@fs) {
if ($delimitor =~ /\t/i) {
$val =~ s/ _TAB_ /\t/g; # "tab"
}
if ($delimitor =~ /\|/i) {
$val =~ s/ _PIPE_ /\|/g; # "pipe"
}
if ($delimitor =~ /\,/i) {
$val =~ s/ _COMMA_ /,/g; # ","
}
$TMP{$fs2} = $val;
$ctfs2++;
$fs2 = "f" . "$ctfs2";
}
# Extract and display matched keys
$tline = $repeated;
# Replace **dbname** **key** or **fn** by the actual value
undef @temp;
(@temp) = split(/\*\*/,$tline);
$repeat_string ="";
foreach $item (@temp) {
# This If applies to all search actions
if ($item eq "key") {
$item =~ s/$item/$key/;
}
if ($item eq "pwd") {
$item =~ s/$item/$pwd/;
}
if ($item eq "dbname") {
$item =~ s/$item/$dbname/;
}
if ($item eq "usdate") {
$item =~ s/$item/$us_date/;
}
if ($item eq "europedate") {
$item =~ s/$item/$europe_date/;
}
if ($item eq "bgcolor") {
if ($oddeven == 0) {
$item =~ s/$item/$bgcolor0/;
}
else {
$item =~ s/$item/$bgcolor1/;
}
}
# This If applies to search and display actions only
if ($item =~ /^f\d*$/) {
$nitem = $TMP{$item};
$nitem =~ s/ *-RET- */ /g;
$nitem =~ s/\</</g;
$nitem =~ s/\>/>/g;
$nitem =~ s/\"/"/g;
$nitem =~ s/^select$//gi;
$nitem =~ s/\.\* _//g;
$item =~ s/$item/$nitem/;
}
$repeat_string .= $item;
}
$ctfs2=1;
$fs2="f1";
until ($ctfs2 > $maxfields) {
$ctfsx = $ctfs2 - 1;
$valx = $fs[$ctfsx];
if ($valx && $valx !~ /^select$/i) {
$repeat_string =~ s/<!-- check-display-$fs2-//ig;
$repeat_string =~ s/check-display-$fs2- -->//ig;
}
else {
$repeat_string =~ s/<!-- check-display-!$fs2-//ig;
$repeat_string =~ s/check-display-!$fs2- -->//ig;
}
$ctfs2++;
$fs2 = "f" . "$ctfs2";
}
print "$repeat_string";
undef %TMP;
if (($itemno >= $mct) && ($nextst >= ( $maxdispscreen + 1 )))
{
$prevst = $nextst - $maxdispscreen;
print "</table><table border=0 cellspacing=0 cellpadding=5
width=90\%>\n<tr>\n<td width=15\%>\n";
# Change action URL for form statement below
print "<form method=\"POST\" action=\"$this_cgi_url
\">\n";
foreach $entry (@pairs) {
($inname, $value) = split(/=/, $entry);
if ($inname !~ /nextstart/i) {
print "<input type=hidden name=\"$inname\"
value=\"$in{$inname}\">\n";
}
}
print "<input type=hidden name=\"nextstart\"
value=\"$prevst\">\n";
print "<input type=\"submit\" value=\"Previous
$maxdispscreen\">\n</form>\n";
print "</td><td width=85\%><b><font color=#ff0000
size=2>\n";
print "Current $nextst to $itemno\n";
print "</font></b></td></tr>\n";
}
}
else {
if ($itemno > $nextend) {
print "</table><table border=0 cellspacing=0 cellpadding=5
width=90\%>\n<tr>\n<td width=15\%>\n";
if ($nextst >= ( $maxdispscreen + 1 )) {
$prevst = $nextst - $maxdispscreen;
# Change action URL for form statement below
print "<form method=\"POST\" action=\"$this_cgi_url
\">\n";
foreach $entry (@pairs) {
($inname, $value) = split(/=/, $entry);
if ($inname !~ /nextstart/i) {
print "<input type=hidden name=\"$inname\"
value=\"$in{$inname}\">\n";
}
}
print "<input type=hidden name=\"nextstart\"
value=\"$prevst\">\n";
print "<input type=\"submit\" value=\"Previous
$maxdispscreen\">\n</form>\n";
}
print "</td>\n<td width=15\%>\n";
# Change action URL for form statement below
print "<form method=\"POST\" action=\"$this_cgi_url
\">\n";
foreach $entry (@pairs) {
($inname, $value) = split(/=/, $entry);
if ($inname !~ /nextstart/i) {
print "<input type=hidden name=\"$inname\"
value=\"$in{$inname}\">\n";
}
}
$nextst2 = $nextend + 1;
print "<input type=hidden name=\"nextstart\"
value=\"$nextst2\">\n";
print "<input type=\"submit\" value=\"Next
$maxdispscreen\">\n</form>\n";
print "</td>\n<td width=70\%><b><font color=#ff0000
size=2>\n";
print "Current $nextst to $nextend\n";
print "</font></b></td></tr>\n";
last;
}
}
if ($oddeven == 0 ) {
$oddeven = 1;
}
else {
$oddeven = 0;
}
}
}
}
}
sub showblank {
&check_template;
open(FL,"$template_dir$in{'template'}");
@nfile=<FL>;
close(FL);
&set_content_type;
# For each html line
foreach $line (@nfile) {
$linet=$line;
# Replace eman="fn" by blank
# One $line can contain only one eman="fn"
if ($linet =~ /eman=\"f.*\"/i) {
$linet =~ s/.*eman=\"//i;
$linet =~ s/\".*//;
chop($linet);
$line =~ s/eman=\"$linet\"//i;
}
$line =~ s/\*\*f\d+\*\*//ig; # r10
print "$line";
}
}
sub return {
print "Location: $ENV{'DOCUMENT_URI'}\n\n";
}
sub check_url_referer {
$referral_cnt = @valid;
if ($referral_cnt > 0) {
foreach $referer (@valid) {
if ($ENV{'HTTP_REFERER'} =~ /$referer/i) {
$good_ref = "yes";
last;
}
}
if ($good_ref ne "yes") {
&go_away;
}
}
}
sub error_no_db_name {
&set_content_type;
print "<html><body><center><font size=+1 color=\"FF0000\">ERROR: No
database filename specified.</font></center>";
print "<p>You must make sure a database filename is
specified.</p></body></html>\n";
exit;
}
sub error_no_template_name {
&set_content_type;
print "<html><body><center><font size=+1 color=\"FF0000\">ERROR: No
template filename specified.</font></center>";
print "<p>You must make sure a template filename is specified for your
output.</p></body></html>\n";
exit;
}
sub error_not_a_command {
&set_content_type;
print "<html><body><center><font size=+1 color=\"FF0000\">ERROR: Not a
valid command.</font></center>";
print "<p>The \"action\" command is not valid. This might have been
caused by reloading a cgi program generated Web page.<p>Please go back to <a
href=\"$return_url\">home page</a> to continue.</p></body></html>\n";
exit;
}
sub nothing_found {
print "<html><body><center><font size=+1 color=\"FF0000\">Sorry! Nothing
found.</font></center>";
print "<p>No records match your search critera. Please press \"Back\"
button and try again.</p></body></html>\n";
exit;
}
sub go_away {
&set_content_type;
print "<html><body><center><font size=+1 color=\"FF0000\">ERROR:
Unauthorised Access.</font></center>";
print "<p>Request denied. You are attempting to access our server using
an unauthorized form.</p></body></html>\n";
exit;
}
sub error_form_method {
&set_content_type;
print "<html><body><center><font size=+1 color=\"FF0000\">Error:
Incorrect Form Request Method.</font></center>";
print "<p>You are not using \"method=get\" or \"method=post\" to submit
your Form. Please contact Webmaster.</p></body></html>\n";
exit;
}
sub set_content_type {
if ($charset eq "") {
print "content-type: text/html\n\n";
} else {
print "content-type: text/html\; charset=$charset\n\n";
}
}
sub check_special_chars {
if ($keyword =~ /^\+*\\*\$*\%*\/*\!*\#*\@*\|*\&*\^*\~*\`*\(*\)*$/i) {
next;
}
else {
$keyword = &replace_spc("$keyword");
}
}
sub replace_spc {
local($word) = shift(@_);
if ($match_special_chars =~ /^yes$/i) {
# DO NOT CHECK ^ AND . THEY ARE USED FOR OTHER PURPOSE
$word =~ s/\+/SPC001/g;
$word =~ s/\\/SPC002/g;
$word =~ s/\$/SPC003/g;
$word =~ s/\%/SPC004/g;
$word =~ s/\//SPC005/g;
$word =~ s/\#/SPC006/g;
$word =~ s/\@/SPC007/g;
if ($delimitor !~ /^\|$/i) {
$word =~ s/\|/SPC008/g;
}
$word =~ s/\&/SPC009/g;
$word =~ s/\~/SPC010/g;
$word =~ s/\`/SPC011/g;
$word =~ s/\(/SPC012/g;
$word =~ s/\)/SPC013/g;
$word =~ s/\[/SPC014/g;
$word =~ s/\]/SPC015/g;
$word =~ s/\{/SPC016/g;
$word =~ s/\}/SPC017/g;
$word =~ s/\</SPC018/g;
$word =~ s/\>/SPC019/g;
}
else {
if ($delimitor =~ /\t/i) {
$word =~ s/[^a-z0-9A-Z\t\^\ ]+/.*/g;
}
elsif ($delimitor =~ /\|/i) {
$word =~ s/[^a-z0-9A-Z\|\^\ ]+/.*/g;
}
elsif ($delimitor =~ /\,/i) {
$word =~ s/[^a-z0-9A-Z\,\^\ ]+/.*/g;
}
else {
$word =~ s/[^a-z0-9A-Z\^\ ]+/.*/g;
}
}
return $word;
}
sub check_dbname {
if ($in{'dbname'} =~ /[^a-z0-9A-Z\ \_\-\.]+/) {
&error_invalid_dbname;
}
else {
$dbname = $in{'dbname'};
}
}
sub error_invalid_dbname {
&set_content_type;
print "<html><body><center><font size=+1 color=\"FF0000\">ERROR: Invalid
database filename (dbname).</font></center>";
print "<p>Please use only alphanumeric characters (space, dot, hyphen,
underscore allowed) for your database filename.</p></body></html>\n";
exit;
}
sub check_template {
if ($in{'template'}) {
if ($in{'template'} =~ /[^a-z0-9A-Z\ \_\-\.]+/) {
&error_invalid_template;
}
}
else {
&error_no_template_name;
}
}
sub error_invalid_template {
&set_content_type;
print "<html><body><center><font size=+1 color=\"FF0000\">ERROR: Invalid
template filename.</font></center>";
print "<p>Please use only alphanumeric characters (space, dot, hyphen,
underscore allowed) for your template filename.</p></body></html>\n";
exit;
}
sub error_invalid_operator_mix {
&set_content_type;
print "<html><body><center><font size=+1 color=\"FF0000\"><b>Error:
Invalid Operator Mix</b></font></center>\n";
print "<p>You can only use either \"&&\" (the <b>AND</b> operator) or
\"++\" (the <b>OR</b> operator) in your search box. Please press the
\"Back\" button to try again.</p>\n";
print "<p><center><b><a href=\"$return_url\">Back
Home</a></b></center></p></body></html>\n";
exit;
}
"Ben Morrow" <usenet@morrow.me.uk> wrote in message
news:bounri$eni$1@wisteria.csv.warwick.ac.uk...
> "Dick Rosser" <spammerswelcome@aol.com> wrote:
> > My perl abilities are limited - to put it mildly!
> > I have obtained a flat-file database search script
> > that fills my needs perfectly, but from what I remember
> > in my old Paradox days it does not seem to have a
> > table locking mechanism.
> >
> > Does the simple addition of $flock = 1; do the trick or
> > does it need something a little more sophisticated.
> > Server is Unix. Which of these is correct:
> > $flock = 1;
> > $flock = "1"; or are they both as good?
>
> Neither. Both simply assign a value to the variable $flock.
>
> How you do locking depends on what you are trying to lock. If by a
> 'table locking mechanism' you mean a lock on an entire file, and this
> script (or other Perl scripts you write yourself) are the only things
> reading or writing that file, then you want to read 'perldoc -f
> flock'.
>
> If, OTOH, there are other programs reading or writing this file that
> you need to synchronise with, you need to know how they do their
> locking: the locks Perl sets with flock() are advisory only, so they
> won't lock out anyone who doesn't cooperate. When you know what sort
> of locking you are trying to use, ask again and someone can tell you
> how to do it in Perl.
>
> Ben
>
> --
> EAT
> KIDS (...er,
whoops...)
> FOR
ben@morrow.me.uk
> 99p
------------------------------
Date: Thu, 13 Nov 2003 04:19:47 +0100
From: Tore Aursand <tore@aursand.no>
Subject: Re: perl script
Message-Id: <pan.2003.11.13.02.27.53.500292@aursand.no>
On Thu, 13 Nov 2003 00:27:33 +0000, Jerry Maguire wrote:
> Can you please help me with extracting xml values using perl?
Can you please confirm that none of the XML modules on CPAN can do this
for you/us?
http://www.cpan.org/
--
Tore Aursand <tore@aursand.no>
------------------------------
Date: Thu, 13 Nov 2003 12:59:33 +1000
From: Schlick <invalid@invalid.com.invalid>
Subject: Re: problem with if-else assignment in text database
Message-Id: <bous2l$pcl$1@bunyip.cc.uq.edu.au>
Tad McClellan wrote:
> Vumani Dlamini <dvumani@hotmail.com> wrote:
>
>
>
>>Thanks again guys, hope you don't get tired of me, like Ted.
>
>
>
> To avoid becoming wearysome, simply see the Posting Guidelines
> that are posted here frequently...
>
>
To become wearisome, simply quote them in every single one of your messages.
------------------------------
Date: 13 Nov 2003 03:09:38 GMT
From: "A. Sinan Unur" <asu1@c-o-r-n-e-l-l.edu>
Subject: Re: Problem with IO::Socket::INET and pop
Message-Id: <Xns9431E16F41CF4asu1cornelledu@132.236.56.8>
Ben Morrow <usenet@morrow.me.uk> wrote in news:boueo5$9cp$1
@wisteria.csv.warwick.ac.uk:
>
> unixverse@yahoo.com (Joe) wrote:
>
>> # Customized Error Function
>> Error("cannot connect to port <B>$Port</B> on <B>$ServerName</B>",
>> "Back");
...
> You need to include $! in the error message so you (and we) have a
> better idea of what's going wrong.
IIRC, $@ is the relevant variable for socket errors.
--
A. Sinan Unur
asu1@c-o-r-n-e-l-l.edu
Remove dashes for address
Spam bait: mailto:uce@ftc.gov
------------------------------
Date: Thu, 13 Nov 2003 02:27:04 GMT
From: James Willmore <jwillmore@remove.adelphia.net>
Subject: Re: REQUEST_URI unavailable
Message-Id: <20031112212440.6924a9bd.jwillmore@remove.adelphia.net>
On Wed, 12 Nov 2003 15:08:15 -0600
"Kubaton Lover" <nospam@goawayspam.com> wrote:
> Could someone tell me when the REQUEST_URI variable is availabe to
> Perl scripts running on the web server? I have a Perl script that
> relies on that variable and for reasons unknown to me, some users'
> browsers are not sending that value. I have checked and they are
> using the same browser that I'm using (IE6.0.28).
Try
$ENV{REQUEST_URI}
maybe?
--
Jim
Copyright notice: all code written by the author in this post is
released under the GPL. http://www.gnu.org/licenses/gpl.txt
for more information.
a fortune quote ...
"His great aim was to escape from civilization, and, as soon as
<he had money, he went to Southern California."
------------------------------
Date: Wed, 12 Nov 2003 21:08:17 -0600
From: tadmc@augustmail.com (Tad McClellan)
Subject: Re: Sorting a multi-dimensional hash
Message-Id: <slrnbr5td1.jsv.tadmc@magna.augustmail.com>
ifiaz <ifiaz@hotmail.com> wrote:
> ##sort routine
> sub byScanTime() {
> Although, I don't understand completely how it works,
You can put some print() statements in the body of byScanTime()
and see what goes by...
--
Tad McClellan SGML consulting
tadmc@augustmail.com Perl programming
Fort Worth, Texas
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
The Perl-Users Digest is a retransmission of the USENET newsgroup
comp.lang.perl.misc. For subscription or unsubscription requests, send
the single line:
subscribe perl-users
or:
unsubscribe perl-users
to almanac@ruby.oce.orst.edu.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
To request back copies (available for a week or so), send your request
to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
where x is the volume number and y is the issue number.
For other requests pertaining to the digest, send mail to
perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
sending perl questions to the -request address, I don't have time to
answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 5790
***************************************
