Newbie wants to flock

[Dick Rosser]

Greetings

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?

Regards
Dick Rosser
(e-mail address removed)

 

[Ben Morrow]

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

 

[Eric Schwartz]

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 it need one? I'm all for locking everywhere it's needed, but you
should only lock when you have multiple processes updating your
database at the same time. A query probably won't update a database
(unless, I suppose, you're doing something nifty like tracking the top
5 most popular searches, or some such), so ideally the only process
writing to your table will be the part that scans your site and
updates the flat file for you.

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?

They're equivalent in both function and form. That is to say, all
they do is set the scalar variable '$flock' to 1. Or "1", as Perl
automagically converts between numeric and string context for you.

As I'm sure you can surmise, setting a variable will not, by itself,
cause any locking to be done. It is possible that your script,
which no-one here has probably ever seen, does something like:

flock(FH, LOCK_EX) if $flock;

But then again, it may not. You should be able to tell if your
program calls flock() though-- just grep for 'flock' in the code, and
that should help you figure it out. To learn more about locking
files, and how and why, see 'perldoc -q lock' and 'perldoc -f flock'

-=Eric

 

[Ben Morrow]

Does it need one? I'm all for locking everywhere it's needed, but you
should only lock when you have multiple processes updating your
database at the same time. A query probably won't update a database
(unless, I suppose, you're doing something nifty like tracking the top
5 most popular searches, or some such), so ideally the only process
writing to your table will be the part that scans your site and
updates the flat file for you.

(I note you assume this is in a CGI context

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.

Ben

 

[Eric Schwartz]

(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

 

[Dick Rosser]

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) {
&nothing_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 actins
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/\</&lt;/g;
$nitem =~ s/\>/&gt;/g;
$nitem =~ s/\"/&quot;/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]

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.

I have included here some general advice that will make your program
more robust and easier to maintain. If you don't care about this,
don't really know Perl, and just want to get it working, then you only
need include the 'use Fcntl' and the 'flock' lines.

#!/usr/bin/perl

use warnings;
use strict;

# add other 'use' statements here: see below

'use strict' means that all your variables will need to be declared
with 'my' the first time you use them. So, for instance, you will need
to change this line

$charset = "";

to

my $charset = "";

.. %ENV, %SIG, and the single-punctuation-character variables (and the
others listed in 'perldoc perlvar') are exempt from this.

# Parse Form Contents
&parse_form;

As a general rule, you should not call subs with an initial '&' in
Perl5. Either use

parse_form();

or add

use subs qw/parse_form search etc./;

at the top and simply call it with

parse_form;

.. (NB that 'etc.' isn't meant literally...

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;
}
}

It is generally a bad idea to parse CGI stuff yourself: there are many
subtleties, and it is easy to make mistakes. A much better idea would
be to add

use CGI;

or

use CGI::Lite;

at the top, and then read 'perldoc CGI' to see how to extract the
paramaters using that module.

($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";

You may want to investigate 'strftime' in 'perldoc POSIX', rather than
doing this by hand.

open(DB,"$database_dir$dbname");

*Always* check the return value of open.

open DB, "$database_dir$dbname" or die "can't open database: $!";

You may want to read 'perldoc CGI::Carp' for a way to send the errors
somewhere sensible in a CGI context.

This is where you actually do the locking. You need

use Fcntl qw/:flock/;

at the top, and then here you put

flock DB, LOCK_SH or die "can't get lock: $!";

here. This will wait until any writing processes have finished (more
precisely, until any lock set with LOCK_EX has been unlocked), and
then lock the file for reading. If you want to be more sophisticated
than that, you will need to read about LOCK_NB in 'perldoc -f flock'.

open(DB,"$database_dir$dbname");

You don't want to re-open the file: you'll lose the lock. I think what
the script is trying to do is go back to the beginning, which is
better achieved by changing the Fcntl line above to

use Fcntl qw/:flock :seek/;

and then using

seek DB, 0, SEEK_SET or die "can't seek back to start: $!";

..

<snip the rest>

[in future, please include a *trimmed* quote above rather than below
your post]

Ben

 

[Ben Morrow]

Yes, bad Eric, no biscuit.

....you were right, of course

Ben

 

[Dick Rosser]

[in future, please include a *trimmed* quote above rather than below
your post]

Many thanks for your time and the pointers given.
Anything I can do to return the favour?
Dick Rosser