SSC_perl wrote:
Hello,
Hello,
This is a one-time post to announce that the SurfShopPRO Perl
shopping cart system is going open source. Our site hasn't been fully
updated yet, but you can download the cart and check it our for
yourself. We are looking for developers, designers, and testers.
http://www.surfshopcart.com/pages/pro.php
By doing this, we hope to generate enough interest in this
project so that we can bring SurfShop up-to-date and turn it into a
powerful example as to why someone should use Perl for e-commerce
again. In my searches on the web, I've found that there are very few,
if any, good open source Perl carts out there that will work on shared
servers. Hopefully we can turn that around.
SurfShop has been around since 1999 and is still used by quite a
few companies around the world. As is, it's a very good cart to use -
it's stable and it's fast. However, it's lacking some features that
more modern carts have, the default template really needs a face lift,
and the Perl code could use some updating, as well.
If anyone is interested in joining this project, please download
the script and join our forum. There you'll find the official listing
of fixes needed and new features planned (we're always open to
suggestions). We will also be implementing a plugin/module system and
will let developers and designers sell their modules and templates
though our online store.
Pros:
- full featured, rock solid, Perl based e-commerce system
- simple to install with autoconfig script
- powerful calculation engine
- full listing available on our site --
http://www.surfshopcart.com/pages/pro2.php
Cons:
- old code -- needs to be updated to modern Perl
- HTML templates are looking a bit stale, too -- needs an HTML5
makeover
- there are a few fixes that are needed -- see the list in our
forum **
- lacks some features to compete with the big boys -- see the
list in our forum **
I'm new to the open source community, so any help that anyone
would be willing to give me will be greatly appreciated. Feel free to
contact me off-list.
Thank you,
Frank Jance
SurfShopCART
Sorry for taking so long to reply, but you had a lot of code to read
through.
Antway, I found some mistakes in your code; to wit:
$ perl -Mwarnings -Mstrict -c ss.lib
Useless use of private variable in void context at ss.lib line 381.
For the line:
381 $replace_tag;
Perhaps you meant that to be:
381 return $replace_tag;
The next is:
admin.cgi:388: $replace->{'history'} += "Returned
$out-{authamt} " . localtime() . "\r";
You are using a string with addition which means it is the same as
saying:
admin.cgi:388: $replace->{'history'} += 0;
The next is:
shop.cgi:763: my $states =
'AL|AK|AZ|AR|CA|CO|CT|DE|FL|GA|HI|ID|IL|IN|IA|KS|KY|LA|ME|MD|MA|MI|MN|MS|MO|MT|NE|NV|NH|NJ|NM|NY|NC|ND|OH|OK|OR|PA|RI|SC|SD|TN|TX|UT|VT|VA|WA|DC|WV|WI|WY';
shop.cgi:764: $main::global->{'form'}->{bprovince} =
$main::global->{'form'}->{Ecom_BillTo_Postal_StateProv} unless
($main::global->{'form'}->{Ecom_BillTo_Postal_StateProv} =~ /^$states$/i);
shop.cgi:765: $main::global->{'form'}->{sprovince} =
$main::global->{'form'}->{Ecom_ShipTo_Postal_StateProv} unless
($main::global->{'form'}->{Ecom_ShipTo_Postal_StateProv} =~
/^$states$/i); # for use with processors that use separate field for
province.
Which means that 'AL' will only match at the beginning of the line and
'WY' will only match at the end of the line and all the other
alternatives will match anywhere in the line.
Perhaps you meant: /^(?:$states)$/i
The next is:
shop.cgi:1408: $address_count++ while ($test_data =~
m/bPO\s?BOX\b|\bPOB\b|\bBOX\b|\bSTREET\b|\bST\b|\bAVENUE\b|\bAVE\b|\bAV\b|\bBLVD\b|\bPLACE\b|\bLANE\b|\bCIRCLE\b|\bDRIVE\b/gi);
It looks like the first alternative should be '\bPO\s?BOX\b', you are
missing a back-slash in front of the 'b'.
The next is:
shop.cgi:1414: my $billto_digits = ($test_data =~
m/[0-9]/g); # count the number of digits
This does not count the number of digits. It just assigns true or
false to $billto_digits.
The next is:
autoconfig.cgi:1187: opendir (DIR, "$main::global->{ddir}/data");
autoconfig.cgi-1188- my @files = readdir (DIR);
autoconfig.cgi-1189- closedir (DIR);
autoconfig.cgi-1190- foreach my $file (@files) {
autoconfig.cgi-1191- $file = $1 if
(Surf::cl("$main::global->{ddir}/data/$file") =~ /(.+)/);
autoconfig.cgi-1192- next unless (-f $file);
autoconfig.cgi-1193- chmod 0666, $file;
forceorder.cgi:409: opendir(CARTS, $path);
forceorder.cgi-410- while (my $cartfile = readdir(CARTS)) {
forceorder.cgi-411- next if (-d $cartfile || $cartfile =~
/^(\.|index)/);
shop.cgi:1767: opendir(CARTS, $path);
shop.cgi-1768- while ($cart = readdir(CARTS)) {
shop.cgi-1769- next if (-d $cart || $cart =~ /^(\.|index)/);
ss.lib:188: opendir (DIR, $directory) ||
error("MakeDirectoryPopup: $directory");
ss.lib-189- my @files = readdir (DIR);
ss.lib-190- close (DIR);
ss.lib-191- foreach $file (@files){
ss.lib-192- next if (-d $file || $file eq '.' ||
$file eq '..');
You are using the value from readdir() without prepending the path to
the file name.
The next is:
ss.lib:1047: my ($null, $conversion, $precisond) = split (/:/, $prec);
ss.lib:1049: $precisiond = $precisiond ne '' ? $precisiond :
$main::global->{'form'}->{'conv_prec'};
ss.lib:1050: $precisiond = $precisiond ne '' ? $precisiond : 2;
ss.lib:1051: my $precision = '%.' . $precisiond . 'f';
On line 1047 $precisond should be $precisiond.
The next is:
ss.lib:2858:sub Form_Value_Encode {
ss.lib-2859- my $form_value = shift;
ss.lib-2860- return '' unless qvalid(form_value);
On line 2860 form_value should be $form_value.
The next is:
autoconfig.cgi:883: print "<font
color=\"336666\">[dir] $dir/$file</font> - .htaccess installed<br>\n";
The variable $file is not assigned a value.
The next is:
admin.cgi:424: my $uid = $1 if ($repl =~ /^(.+?)_retinv/);
admin.cgi:447: my $uid = $1 if ($key =~ /^(.+?)_delete/);
admin.cgi:496: my $database = $1 if
(Surf::cl($main::global->{'form'}->{'b'}) =~ /(.+)/);
admin.cgi:628: my $contenttype = $1 if ( $header =~
/Content-Type:\s*(.*?)\n/i);
admin.cgi:629: my $mailto = $1 if ( $header =~
/To:\s*(.*?)\n/i );
admin.cgi:630: my $from = $1 if ( $header =~
/From:\s*(.*?)\n/i );
admin.cgi:631: my $subject = $1 if ( $header =~
/Subject:\s*(.*)/i ); # subject must be last
admin.cgi:677: my ($hundreds, $cents) = ($1, $2) if ($total =~
/(\d{0,3})\.(\d{2})$/);
admin.cgi:678: my $thousands = $1 ? hundreds($1) . 'thousand, ' : '' if
($total =~ /^[-+]?(\d+)\d{3}/);
autoconfig.cgi:1140: my $upgrade = 1 if (-e
"$main::global->{ddir}/data/file.lock");
ss.lib:58: my $tablestr = MakeTable($1) if ($storystr
=~/\^\^(.*?)\^\^/);
ss.lib:687: my $widow = $main::global->{'form'}->{stotal} %
$showcols if ($showcols);
ss.lib:2237: my $add = '...' if (length($string) > 256);
SurfDB.pm:630: my $alpha = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' if ($mode =~ /up/);
This is documented in perlsyn (Perl syntax) at the end of the
"Statement Modifiers" section:
perldoc perlsyn
NOTE: The behaviour of a "my" statement modified with a statement
modifier conditional or loop construct (e.g. "my $x if ...") is
undefined. The value of the "my" variable may be "undef", any
previously assigned value, or possibly anything else. Don't rely
on it. Future versions of perl might do something different from
the version of perl you try it out on. Here be dragons.
The next is:
autoconfig.cgi:1117: opendir(DIR, "$datadir/data");
autoconfig.cgi-1118- my @files = readdir(DIR);
autoconfig.cgi-1119- close DIR;
ss.lib:188: opendir (DIR, $directory) ||
error("MakeDirectoryPopup: $directory");
ss.lib-189- my @files = readdir (DIR);
ss.lib-190- close (DIR);
You are attempting to close a directory handle with close() instead of
closedir(). In autoconfig.cgi you don't verify that opendir() created
a valid directory handle.
The following are not "errors" but contain questionable code.
forceorder.cgi-126- close CART;
forceorder.cgi:127: flock CART, 8;
shop.cgi:1079: close CART;
shop.cgi:1080: chmod (0666, $cartfile);
shop.cgi:1081: flock CART, 8;
shop.cgi:1757: close CTLOCK;
shop.cgi:1758: flock CTLOCK, 8;
SurfDB.pm:381: close $self->{'LOCK'}; #release lock file
SurfDB.pm:382: flock ($self->{'LOCK'}, 8);
ipn.pl-40- close IPNTXNLOG;
ipn.pl:41: flock IPNTXNLOG, 8;
ipn.pl-107- close IPNTXNLOG;
ipn.pl:108: flock IPNTXNLOG, 8;
ss.lib:1807: close ORDERLOCK;
ss.lib:1808: flock ORDERLOCK, 8;
ss.lib-1944- close (AUTH);
ss.lib:1945: flock (AUTH, 8);
ss.lib-1966- close (AUTH);
ss.lib:1967: flock (AUTH, 8);
The use of flock() does not do what you seem to think it is doing.
If you add error checking you will see the problem:
$ perl -le'
open (ORDERLOCK, ">>", "$path.lock") or die "open: $!";
flock (ORDERLOCK, 2) or die "flock 2: $!";
close ORDERLOCK or die "close: $!";
flock ORDERLOCK, 8 or die "flock 8: $!";
'
flock 8: Bad file descriptor at -e line 5.
After you close the filehandle it is not valid any more so there is
nothing that flock() can do with it. But that is usually OK because
close will unlock the file which is why your code works. Also, you
should use the constants LOCK_SH, LOCK_EX, and LOCK_UN provided by:
use Fcntl ':flock';
shop.cgi:1921: $rel =~ tr/[a-zA-Z0-9\-]//cd;
ss.lib:2726: $string =~ tr/[a-z]/[A-Z]/;
ss.lib:2730: $string =~ tr/[A-Z]/[a-z]/;
Surf.pm:213: $source =~ tr /[a-m][n-z]/[n-z][a-m]/; # performs rot13
swapping (lc)
Surf.pm:214: $source =~ tr /[A-M][N-Z]/[N-Z][A-M]/; # performs rot13
swapping (caps)
In ss.lib and Surf.pm you are translating '[' to '[' and ']' to ']'.
These characters are unnecessary in these four cases so I wondering if
they are also unnecessary in the shop.cgi example? Converting a string
to upper or lower case is usually handled by using the uc() and lc()
functions and ROT13 is usually coded as tr/a-zA-Z/n-za-mN-ZA-M/.
Surf.pm:65: $cookie =~ Encode($cookie);
Surf.pm:66: $value =~ Encode($value);
Did you really mean to use the return value from Encode()as a regular
expression?
autoconfig.cgi:706: Surf::cl("$main::global->{ddir}/data/.p") =~ /(.*)/;
autoconfig.cgi-707-
Surf::cl("$main::global->{ddir}/data/config.dat") =~ /(.*)/;
autoconfig.cgi-708- my $path = $1;
$path will be assigned a value from either line 707 or line 706 or from
the last successful pattern match.
You should only use the results from capturing parentheses if you know
that the pattern matched successfully.
Email.pm:42: if ($receiver =~ /,/) {
Email.pm-43- @recipients = split (/,/, $receiver); # split
the addresses at the commas
Email.pm-44- $receiver = shift (@recipients); # 1st
address in list
Email.pm-45- $others = join (',', @recipients); #
remaining addresses in list
Email.pm-46- $receiver .= ',' . $others; # put
them all back together
Email.pm-47- }
This code modifies $receiver back to its original state, but for what
purpose?
$ perl -le'
my $receiver = "one,two,three,four";
print $receiver;
@recipients = split (/,/, $receiver);
$receiver = shift (@recipients);
$others = join (",", @recipients);
$receiver .= "," . $others;
print $receiver;
'
one,two,three,four
one,two,three,four
admin.cgi:503: 1 if (Surf::cl($file) =~ /(.+)/);
admin.cgi:881: 1 if
(Surf::cl("$main::global->{ddir}/output/$temp") =~ /(.+)/);
ss.lib:7001: 1 if (Surf::cl("$main::global->{ddir}/data/ordercounter")
=~ /(.+)/);
SurfDB.pm:11205: 1 if
(Surf::cl("$self->{'DATADIR'}/$self->{'DB'}") =~ m|(.+)\/(\w+)|);
SurfDB.pm:11601: 1 if (Surf::cl($path) =~ m|(.+)\/(\w+?)\.\w+$|);
# untaints file path for safe I/O operations
SurfDB.pm:11943: 1 if
(Surf::cl("$self->{'DATADIR'}/$self->{'DB'}") =~ m|(.+)\/(\w+)|);
SurfDB.pm:12419: 1 if
(Surf::cl("$self->{'DATADIR'}/$self->{'DB'}") =~ m|(.+)\/(\w+)|);
This looks like someone saw code like:
SurfDB.pm:182: 1 while ($search->{'searchtext'} =~
s/['"](.+?)['"]/&xterms($1,\@terms)/eg);
SurfDB.pm:1067: 1 while ($search->{'searchtext'} =~
s/['"](.+?)['"]/&xterms($1, \@terms)/eg);
ss.lib:450: 1 while ($str =~
s/(.{18}[\w\.]*)/&makeOptionRows($1, \@rows)/seig);
Which does something useful by looping until the substitution fails, but
if does not loop so:
1 if expression;
Is exactly the same as:
expression;
Also, not an error but code like:
181 $index = 0;
182 while ($index < length($plaintext)) { # go through
each character and swap bits with key
183 $char = substr($plaintext, $index, 1);
184 $key_char = substr($key, $index, 1);
185 $encrypted .= chr(ord($char) ^ ord($key_char));
# THE MEAT OF THE ENCRYPTION
186 $index++;
187 }
Could be written more simply as:
$encrypted = $plaintext ^ $key;
And:
199 $index = 0;
200 while( $index < length($encrypted) ) { # swap bits
with key
201 $char = substr($encrypted, $index, 1);
202 $key_char = substr($key, $index, 1);
203 $decrypted .= chr(ord($char) ^ ord($key_char));
# THE MEAT OF THE ENCRYPTION
204 $index++;
205 }
As:
$decrypted = $encrypted ^ $key;
John
--
Any intelligent fool can make things bigger and
more complex... It takes a touch of genius -
and a lot of courage to move in the opposite
direction. -- Albert Einstein
--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/
