Can anyone help with the following code

[Aaron Brockhurst]

Hi

I am trying to get the following code to work but am really struggling
to find out why the sub routines getPreviousDetails and
getPreviousEmail dont work. I am trying to use the script on a
charity auction page. I've put the code below

Can anyone provide any solutions

Thanks in advance
Aaron

#!/usr/bin/perl
#!c:\perl\bin\perl
#-----------------------------------------------------------#
#
# script name: placebid.cgi
# description: This script places a bid for the chosen item.
#
#-----------------------------------------------------------#

use Fcntl qwflock); # imports LOCK_EX, LOCK_SH, LOCK_NB
use CGI qw( :standard :html3 );
use CGI;
use CGI::Carp 'fatalsToBrowser';

my $loginname = param('username');
my $password = param('password');
my $bid = param('bid');
my $itemcode = param('itemid');
my $itemname = param('itemname');
my $submityet = param('submityet');
my $startamount = param('startamount');
my $maxbid = param('maxbid');

my $SETTINGS;

################## Read in the configuration ########################
open CONFIGFILE, "< configuration.dat" || die "Failed to open
configuration file: $!"; # Open the configuration file
while (<CONFIGFILE>) {
my $line = $_;
next if ($line=~/^#/);
my ($key,$value) = split(/=/,$line);
$value=~s/\n|\r//g;
$value=~s/'//g;
chomp($value);
$SETTINGS{$key}=$value;
}
close(CONFIGFILE);

################### Include the language file ######################
do $SETTINGS{'languagefile'} || die "Failed to include language file:
$!"; # include the language file
####################################################################
#------------------------------------------------------------------#

sub printFile
{
my ($file) = @_;
open FH, "<$file" or return;
print while (<FH>);
close FH; # do not complain if it cannot
}

#------------------------------------------------------------------#

# function that will check to ensure the username are password match
and are ok
sub checkLogin() {
my ($loginname) = @_;

open USERFILE, " $SETTINGS{'userfile'}" || die "Failed to open file:
$!";
if ($^O ne "MSWin32") { flock(USERFILE, LOCK_EX); }
while (<USERFILE>) {
my @fields = split(/\t/,$_); # split $line, using : as delimiter
if (@fields[1]=~m/^$loginname$/) {
if (@fields[2]=~m/^$password$/) {
$matchokay='true'; # login name matches password
}
}
}
close(USERFILE);

if ($matchokay) { return $matchokay; }
else { return ''; }
}

#----------------------------------------------------------#

sub getBidInfo {

my ($itemcode)=@_[0];
my $latestbid = '';
my $i = '';
my $no_bids = '0';

#open the bidfile and find the item
my $bidfile = "$SETTINGS{'bidfiledir'}/$itemcode-bidfile.tab";

#print "<font color=white>$bidfile<br></font>";
open BIDFILE1, " $SETTINGS{'bidfiledir'}/$itemcode-bidfile.tab" ||
die "Failed to open file: $!";
if ($^O ne "MSWin32") {
flock(BIDFILE1, LOCK_EX);
}
while (<BIDFILE1>) {
$$itemcode_bidfile_contents[$i] = $_;
$i++;
}
close(BIDFILE1);

foreach my $record (@$itemcode_bidfile_contents) {
my @fields = split(/\t/,$record); # split $line, using : as
delimiter
if (@fields[0]=~m/^$itemcode$/) {
if (@fields[2] >= $latestbid) { $latestbid=@fields[2];
$no_bids++; }
}
}

$no_bids--; # take 1 off because the first bid isn't a bid, but the
start price

return "$latestbid-$no_bids";

}

#----------------------------------------------------------#

# function that will check to ensure the bid is acceptable
sub checkBid
{
my ($itemcode)=@_[0];
my ($bid)=@_[1];
my $badbid = '';
my $no_bids=0;

open BIDFILE2, " $SETTINGS{'bidfiledir'}/$itemcode-bidfile.tab" ||
die "Failed to open file: $!";
if ($^O ne "MSWin32") {
flock(BIDFILE2, LOCK_EX);
}
while (<BIDFILE2>) {
$bidfile_contents[$no_bids] = $_;
$no_bids++;
}
close(BIDFILE2);

foreach my $record (@bidfile_contents) {
my @fields = split(/\t/,$record);
if (@fields[0]=~m/^$itemcode$/) {
if (@fields[2] >= $bid) {
$realbid = @fields[2];
$badbid = $lang{'placebid error1'};
} elsif ($startamount>$bid) {
$realbid = @fields[2];
$badbid = $lang{'placebid error2'};
}
}
}

if ($badbid) { return ''; }
else { return 'Bid Okay'; }
}

#----------------------------------------------------------#

# function that will check to ensure the bid is acceptable
sub checkMaxBid
{
my ($bid)= shift;
my ($maxbid)= shift;

if ($bid < $maxbid) { return 'ok'; }
else { return ''; }
}

#----------------------------------------------------------#

#function to get todays date
sub todaysDate
{
#get todays date
$time = localtime(4);
@months = ("January","February","March","April","May","June","July","August","September","October","November","December");
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
$yr=1900+$year; #just as the perl docs said ( for y2k bug )
# added tdf 17/01/2002
if ($min < 10) { $min='0'.$min; }
if ($hour < 10) { $hour='0'.$hour; }
$date = "$mday-@months[$mon]-$yr-$hour:$min"; # 12:25:30 30 August
2000
return $date;
}

#----------------------------------------------------------#

sub writeBid
{
my ($bid)=@_[0];
my ($loginname)=@_[1];
my ($password)=@_[2];
my ($itemcode)=@_[3];
my ($maxbid)=@_[4];

# get todays date
my $today = &todaysDate();

# now open the file and add the new details.
open BIDFILE4, ">>$SETTINGS{'bidfiledir'}/$itemcode-bidfile.tab" ||
die "Failed to open BidFile: $!";
if ($^O ne "MSWin32") {
flock(BIDFILE4, LOCK_EX);
}
print BIDFILE4 "$itemcode\t$loginname\t$bid\t$today\t$maxbid\n" ||
die "Failed to write to BidFile: $!"; # die added tdf 20/12/2001
close BIDFILE4 || die "Failed to close BidFile: $!"; # die added tdf
20/12/2001
}

#----------------------------------------------------------#

sub getPreviousEmail
{
my $previous_loginname = '';
my $previous_email = '';


# find out the last user to place a bid on this item
#print "Opening file: $bidfiledir/$itemcode-bidfile.tab<br/>";
open BIDFILE5, " $bidfiledir/$itemcode-bidfile.tab" || die "Failed
to open file: $!";
if ($^O ne "MSWin32") {
flock(BIDFILE5, LOCK_EX);
}
while (<BIDFILE5>) {
my @fields = split(/\t/,$_); # split
if (@fields[0]=~m/^$itemcode$/) {
$previous_loginname = @fields[1];
}
#print "Previous loginname: $previous_loginname<br/>";
}
close(BIDFILE5);
if ($previous_loginname eq '') { $previous_loginname = 'Aaron'; }

# match this loginname with one in the user_contents
# get the email address from there


foreach my $record (@user_contents) {
#print "Each record looks like this: $record<br/>";
my @fields = split(/\t/,$record); # split $line, using \t as
delimiter
if (@fields[1]=~m/^$previous_loginname$/) { #print "found matching
name";
$previous_email = @fields[9];
}
#print "Previous Email: $previous_email<br/>";
}


# return the previous email

return $previous_email;
}

#----------------------------------------------------------#

sub informItemWatch {
my $itemcode = shift;
my $email;
my $name;
my $itemwatchfile="$SETTINGS{'itemwatchdir'}/$itemcode-itemwatch.tab";
if (-e $itemwatchfile) {
open ITEMWATCH, " $itemwatchfile";
if ($^O ne "MSWin32") { flock(ITEMWATCH, LOCK_EX); }

while (<ITEMWATCH>) {
my ($itemcode_old,$loginname_old) = split(/\t/,$_);
$loginname_old=~s/\n|\r//g;
chomp($loginname_old);
if ($loginname!~m/^$loginname_old$/ig) {
# get email and send

foreach my $record (@userfile_contents) {
my @fields = split(/\t/,$record); # split $line, using : as
delimiter

if (@fields[1]=~m/^$loginname_old$/ig) {
$email = @fields[9];
$name = @fields[3];

my $message=<<_EOM_;
Dear Auction User\n
This is an auto generated message from $SETTINGS{'auctionname'}
Auction to inform you
that a bid has been placed for $itemname\n

Click on the link below to get back in the game!\n
$SETTINGS{'website'}/$SETTINGS{'auctionroot'}/auction.cgi?searchid=$itemcode\n

Regards,
$SETTINGS{'auctionname'} Auction Management

_EOM_

if ($SETTINGS{'mailprog'}) {
open ( FILE, "|$SETTINGS{'mailprog'}") or die "Failed to
deliver email on open: $!";
# Print Message in _HERE_ string
print FILE <<MSG;
to: $email
from: $SETTINGS{'auctionname'}
reply-to: $SETTINGS{'adminemail'}
subject: $SETTINGS{'auctionname'} - Item Watch
MSG
print FILE $message;
close FILE || die "Failed to deliver message on close:
$!";
}
}
}
}
}
close(ITEMWATCH);
}
return;
}

#----------------------------------------------------------#

sub getPreviousDetails {
my $previous_loginname = '';
my $previous_bid = '';
my $previous_date = '';
my $previous_maxbid = '';

open BIDFILE, "< $SETTINGS{'bidfiledir'}/$itemcode-bidfile.tab" ||
die "Failed to open bidfile for reading:$!";
if ($^O ne "MSWin32") {
flock(BIDFILE, LOCK_EX);
}
while (<BIDFILE>) {
my $prev_details = $_;
$prev_details=~s/\n|\r//g;
chomp($prev_details);
($previous_itemcode,$previous_loginname,$previous_bid,$previous_date,$previous_maxbid)
= split(/\t/,$prev_details);
#print "$previous_itemcode - $previous_maxbid<br/>";
}
close BIDFILE || die "Failed to close BidFile: $!"; # die added tdf
20/12/2001
#print "<font color=red>$previous_maxbid</font><br/>";
#print "<br/>";

return "$previous_loginname|$previous_bid|$previous_date|$previous_maxbid";
#return "$previous_loginname|$previous_bid|$previous_date|120";
}

#----------------------------------------------------------#

sub checkItemcode
{
my ($itemcode)=@_[0];
my ($codestatus)='';

open AUCTION1, " $SETTINGS{'auctionfile'}" || die "Failed to open
file: $!";
if ($^O ne "MSWin32") {
flock(AUCTION1, LOCK_EX);
}
while (<AUCTION1>) {
my @fields = split(/\t/,$_); # split $line, using : as delimiter
if (@fields[0]=~m/^$itemcode$/) { #print "found matching name";
$codestatus = 'true';
}

}
close(AUCTION1);

return $codestatus;

}

#----------------------------------------------------------#

sub getBidIncrement {
my ($itemcode) = shift;
my $bid_inc = '';

open AUCTION1, " $SETTINGS{'auctionfile'}" || die "Failed to open
file: $!";
if ($^O ne "MSWin32") {
flock(AUCTION1, LOCK_EX);
}
while (<AUCTION1>) {
my ($id,$itemname,$description,$startdate,$expiry,$bidincrement,$reserveprice,$photo,$category)
= split(/\t/,$_);
if ($id eq $itemcode) {
$bid_inc = $bidincrement;
}
}
close(AUCTION1);

return $bid_inc;
}

#----------------------------------------------------------#

sub sendEmail
{
my ($address) = shift;

#send an email to the previous bidder to tell them their bid has
been passed
#
#print "Sending Email to Address: $address";

open ( FILE, "|$SETTINGS{'mailprog'}") or die "Failed to deliver
email on open\n";

# Print Message in _HERE_ string
print FILE <<MSG;
to: $address
from: $SETTINGS{'auctionname'}
reply-to: $SETTINGS{'adminemail'}
subject: $SETTINGS{'auctionname'}
MSG

print FILE <<_EOM_;

**********************************************\n
$SETTINGS{'auctionname'}\n
**********************************************\n

This is a courtesy email to let you know that you have been outbid on
the
auction item: $itemname\n

Someone has outbid you but if you are quick you could still win by
placing another bid on this auction!\n

Click on the link below to get back in the game!\n
$SETTINGS{'website'}/$SETTINGS{'auctionroot'}/auction.cgi?searchid=$itemcode\n

Good luck and thanks for Bidding.\n

_EOM_

close FILE; # or die "Failed to deliver message on close\n";


}


#---------------Main Program-----------------------#

my $access = &checkLogin($loginname);

print "Content-type: text/html\n\n";
printFile('header.html');
print "<center>";
my $itemcodeokay = &checkItemcode($itemcode);

#if access is granted then check the bid is greater than the bid
already in the file.
if ($submityet eq 'true') {
if ($itemcodeokay) {
if (($access) and ($submityet eq 'true')) {
my $bidok = &checkBid($itemcode,$bid);
if ($bidok) { # if bid is ok then write the bid to the bid
file.

# check if maxbid is set
if ($maxbid) {
my $maxbidok = &checkMaxBid($bid,$maxbid);
}

($current_loginname,$current_bid,$current_date,$current_maxbid) =
split(/\|/,&getPreviousDetails()); #print
"<p>$previous_loginname,$previous_bid,$previous_date,$previous_maxbid</p>";

my $previous_email = &getPreviousEmail();

&writeBid($bid,$loginname,$password,$itemcode,$maxbid);
#if ($^O ne "MSWin32") { &sendEmail($previous_email); }

my $bid_inc = &getBidIncrement($itemcode);
while ($current_maxbid > $bid) {
$bid = $bid+$bid_inc;

$maxbid = $current_maxbid;
$loginname = $current_loginname;

# ($current_loginname,$current_bid,$current_date,$current_maxbid)
= split(/\|/,&getPreviousDetails());

#if (($bid <= $maxbid) and ($current_loginname ne
$loginname)) {
if ($bid <= $maxbid) {
if ($loginname!~m/Autobid/) {
$loginname.=" (Autobid)";
}
my $previous_email = &getPreviousEmail();
&writeBid($bid,$loginname,$password,$itemcode,$maxbid);
}
}

if ($^O ne "MSWin32") { &sendEmail($previous_email); }

################# Bidding phase is over ###############
# You need to now inform users using itemwatch that a bid has
been made on this item
#if ($^O ne "MSWin32") { &informItemWatch($itemcode); }
##########################################

print "<h3>$lang{'Congratulations Bid Accepted'}</h3>
<p>$lang{'placebid message1'}</p>
<p>$lang{'placebid message6'}</p>
<p><a href=\"auction.cgi\">$lang{'Back to Auction'}</a></p>";

} else {
$error = "<h3>$lang{'Bid not accepted'}</h3>
<p>$lang{'placebid error1'}</p>
<p>$lang{'placebid error2'}</p>
<p>$lang{'placebid error3'}:
<b>$SETTINGS{'currency'}$startamount</b></p>";
print $error;
}
} else {
$error = "<p>$lang{'Login Failed'}</p>
<p>$lang{'placebid message2'}</p>
<p>$lang{'placebid message3'}</p>";
print $error;
}
} else {
$error = "<h3>$lang{'Itemcode Not Recognised'}</h3>";
print $error;
}
} else {

print <<_EOM_;

<center>
<form action="placebid.cgi" method="post" name="placeabid"><a
name="placebidd"></a>

_EOM_
if ($SETTINGS{'privateauction'}=~m/^no$/ig) {
print <<_EOM_;
<p>$lang{'placebid message4'}</p>
_EOM_
} else {
print "<br/>";
}
print <<_EOM_;
<p>$lang{'placebid message5'} $SETTINGS{'currency'}$startamount</p>
<table border="0" width="300" cellspacing="0" cellpadding="0">
<tr>
<td class="bordercolour">
<table border="0" width="100%" cellpadding="5"
cellspacing="1">
<tr>
<td class="headercell">
<table width="100%">
<tr>
<td><img src="images/money1.gif"></td><td><div
class="dialogheader">Place a bid for $itemname</div></td>
</tr>
</table>
</td>
<tr>
<td class="content">
<table cellpadding="5" cellspacing="1" width="300">
<tr>
<td>$lang{'Login Name'}</td><td><input type="text"
name="username" size="11"></td>
</tr><tr>
<td>$lang{'Password'}</td><td><input type="password"
name="password" size="11"></td>
</tr><tr>
<td>$lang{'Bid'} ($SETTINGS{'currency'})</td><td><input
type="text" name="bid" size="6" value="$startamount"><a
href=\"javascript:convert(placeabid.bid.value);\">[$lang{'convert'}]</a></td>
</tr><tr>
<td>$lang{'Max Bid'} ($SETTINGS{'currency'})</td><td><input
type="text" name="maxbid" size="6" value=""><a
href=\"javascript:convert(placeabid.maxbid.value);\">[$lang{'convert'}]</a></td>
</tr><tr>
<td align="center" bgcolor="white" colspan="2"><input
type="submit" value="$lang{'Place your Bid'}" class="headercell"></td>
</tr>
</table><input type="hidden" name="startamount"
value="$startamount">
<input type="hidden" name="submityet" value="true">
</td>
</tr>
</table>
</td>
</tr>
</table>

<script language=javascript>
<!--

// if there's a cookie set drop the username and password value into
the form

if (document.cookie) {
document.placeabid.username.value=cookie_information[\"username\"];
document.placeabid.password.value=cookie_information[\"password\"];
}

//--></script>

<input type="hidden" name="itemid" value="$itemcode">
<input type="hidden" name="itemname" value="$itemname">
</form>

_EOM_

}
print "</center>";
printFile('footer.html');

 

[Uri Guttman]

fix your line wrap.

don't post long complete programs. reviewing 600 lines is real work.

if this is third party code, get the author to fix it. we don't repair
free and broken scripts.

otherwise the code has many problems (from a cursory scan).

it uses stuff like @fields[2] (which is actually correct in perl6! so
the author is thinking ahead there) which is wrong.

my $i = '';

odd way to initialize a counter.

while (<BIDFILE1>) {
$$itemcode_bidfile_contents[$i] = $_;
$i++;
}

obviously warnings and strict aren't enabled. that would barf on
warnings for converting a null string to 0

and why is that using a scalar to hold an array that is used only one
other place? blecch.

@itemcode_bidfile_contents = <BIDFILE1> ;

there is tons more to be redone in this pile of crap.

i suggest you burn it, get your money back if possible and hire a
programmer to create a proper script.

uri

 

[Eric J. Roode]

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

(e-mail address removed) (Aaron Brockhurst) wrote in

Hi

I am trying to get the following code to work but am really struggling
to find out why the sub routines getPreviousDetails and
getPreviousEmail dont work. I am trying to use the script on a
charity auction page. I've put the code below

Can anyone provide any solutions

Thanks in advance
Aaron

For one thing, "don't work" is so vague as to be useless. What do you
expect to happen, and what is actually happening? If you go to a doctor
and say "I don't feel well", guess what? He's going to ask you what your
symptoms are. Please tell us your program's symptoms!

Second, the 600 line script you posted is, I'm afraid, extremely poor code.
I am not surprised that it is broken :-/ Where did you get it? You may
want to avoid that source in the future.

- --
Eric
$_ = reverse sort qw p ekca lre Js reh ts
p, $/.r, map $_.$", qw e p h tona e; print

-----BEGIN PGP SIGNATURE-----
Version: PGPfreeware 7.0.3 for non-commercial use <http://www.pgp.com>

iQA/AwUBPyWgbWPeouIeTNHoEQKZdACg9NUw1/6TO6BW0LJjT4g/w9mnsT4An3Is
flPpujQJP97jeZP14yUM6QjG
=pMtQ
-----END PGP SIGNATURE-----

 

[Uri Guttman]

EJR> Second, the 600 line script you posted is, I'm afraid, extremely
EJR> poor code. I am not surprised that it is broken :-/ Where did
EJR> you get it? You may want to avoid that source in the future.

he replied via email to my post (cc'ed to him) saying 'thanks for your
advice'.

i suspect he wrote it. bid scripts aren't generic enough to make it to
the script kiddie archives.

uri