SSC_perl wrote:
Again, let us know what you think! Your feedback, as always, is
appreciated.
Regards,
Frank Jance
Hello Frank,
It looks like you still have some of the same problems I pointed out
last year in November.
To begin, these files do not have a terminating newline, so they are
technically NOT "text" files:
admin.cgi
autoconfig.cgi
forceorder.cgi
shop.cgi
useradmin.cgi
log_notification.pl
ss_files/Multipart.pm
ss_files/SSLib.pm
ss_files/Surf.pm
ss_files/Validator.pm
The following was pointed out last year:
shop.cgi:739: 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-740- $main::global->{'form'}->{'bprovince'} =
$main::global->{'form'}->{'Ecom_BillTo_Postal_StateProv'} unless
($main::global->{'form'}->{'Ecom_BillTo_Postal_StateProv'} =~ /^$states$/i);
shop.cgi-741- $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.
Your regular expression says: /^AL|AK|AZ|AR|...|DC|WV|WI|WY$/i. Which
means that you want to match 'AL' only at the beginning of the line or
match 'WY' only at the end of the line or match the other strings
anywhere in the line. It looks like you probably want to have something
like this:
my $states =
qr/\A(?:A[KLRZ]|C[AOT]|D[CE]|FL|GA|HI|I[ADLN]|K[SY]|LA|M[ADEINOST]|N[CDEHJMVY]|O[HKR]|PA|RI|S[CD]|T[NX]|UT|V[AT]|W[AIVY])\z/i;
$::global->{form}{bprovince} =
$::global->{form}{Ecom_BillTo_Postal_StateProv} if
$::global->{form}{Ecom_BillTo_Postal_StateProv} !~ /$states/;
$::global->{form}{sprovince} =
$::global->{form}{Ecom_ShipTo_Postal_StateProv} if
$::global->{form}{Ecom_ShipTo_Postal_StateProv} !~ /$states/; # for use
with processors that use separate field for province.
Also from last year:
ss_files/Validator.pm:123: my $address_count = 0;
ss_files/Validator.pm:124: $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|\bPARKWAY\b|\bPKWY\b|\bCT\b|\bPLACE\b|\bPL\b|\bLANE\b|\bROAD\b|\bRD\b|\bCIRCLE\b|\bDRIVE\b|\bDR\b/gi);
The first string /bPO\s?BOX\b/ does not have a word boundary at the
beginning, unlike the rest of the strings. It would probably be better as:
my $address_count = () = $test_data =~
/\b(?:PO\s?BOX|POB|BOX|STREET|ST|AVENUE|AVE?|BLVD|PARKWAY|PKWY|CT|PLACE|PL|LANE|ROAD|RD|CIRCLE|DRIVE|DR)\b/gi;
And, another one:
ss_files/Validator.pm:130: my $billto_digits =
($test_data =~ m/[0-9]/g); # count the number of digits
That does not actually count the number of digits. You want something
like this:
my $billto_digits = $test_data =~ tr/0-9//; # count the number of digits
autoconfig.cgi:1292: my $letters =
'0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNPQRSTUVWXYZ';
You are missing the letter O from your list.
forceorder.cgi:412: opendir(CARTS, $path);
forceorder.cgi-413- while (my $cartfile = readdir(CARTS)) {
forceorder.cgi-414- next if (-d $cartfile || $cartfile =~
/^(\.|index)/);
-d $cartfile tries to stat() the file in the current directory but it
should be: -d "$path/$cartfile"
shop.cgi:1151: opendir (my $dh, $payloads);
shop.cgi-1152- my @files = readdir($dh);
shop.cgi-1153- closedir ($dh);
shop.cgi-1154- foreach my $file (@files) {
shop.cgi-1155-# next if ($file eq '.' || $file eq '..');
shop.cgi-1156- next if ("$payloads/$file" eq '.' ||
"$payloads/$file" eq '..');
"$payloads/$file" will NEVER be equal to either '.' or '..'. The
commented out line is the correct way to do it.
shop.cgi:1304: opendir(my $carts, $path);
shop.cgi-1305- while (my $cart = readdir($carts)) {
shop.cgi-1306-# next if (-d $cart || $cart =~ /^(\.|index)/);
shop.cgi-1307- next if (-d "$path/$cart" || "$path/$cart" =~
/^(\.|index)/);
"$path/$cart" =~ /^(\.|index)/ should be: $cart =~ /^(\.|index)/
autoconfig.cgi:1207: opendir(my $datadir_dh, "$datadir/data") ||
SSLib::error("Error opening: $datadir");
autoconfig.cgi-1208- my @files = readdir($datadir_dh);
autoconfig.cgi-1209- close $datadir_dh;
You need to use closedir() on a handle opened with opendir().
ss_files/SSLib.pm:1428: opendir (my $DIR, $directory) ||
error("make_directory_popup: $directory");
ss_files/SSLib.pm-1429- my @files = readdir($DIR);
ss_files/SSLib.pm-1430- closedir ($DIR);
ss_files/SSLib.pm-1431- foreach my $file (@files) {
ss_files/SSLib.pm-1432-# next if (-d $file ||
$file eq '.' || $file eq '..');
ss_files/SSLib.pm-1433- next if (-d
"$directory/$file" || "$directory/$file" eq '.' || "$directory/$file" eq
'..');
"$directory/$file" will NEVER be equal to either '.' or '..'. It should
be: next if -d "$directory/$file" || $file eq '.' || $file eq '..';
Or: next if -d "$directory/$file" || $file =~ /\A\.\.?\z/;
forceorder.cgi:134: open (my $cart_fh, '>', "$cartname.complete");
forceorder.cgi:648:open(PPNTRACELLOG, '>', './tracelog-search.txt');
shop.cgi:1273: open (my $ct_lock, '>>', "$index.lock");
shop.cgi:1275: open (my $count_1, '>>', "$index.dat");
shop.cgi:1281: open (my $ct_locks, '>>', "$index.lock");
shop.cgi:1283: open (my $count_2, '<', "$index.dat");
shop.cgi:1292: open (my $count_3, '>', "$index.dat");
shop.cgi:1323: open (my $wish_fh, '<', $wishfile);
shop.cgi:1370: open (my $wish_fh, '>', $wishfile);
autoconfig.cgi:766: open (my $order_counter_fh, '>',
"$main::global->{'ddir'}/data/ordercounter.txt");
autoconfig.cgi:930: open (my $pass1_fh, $path);
autoconfig.cgi:977: open (my $config_fh, '>', $datapath);
autoconfig.cgi:1244: open (my $path_tmp_fh, "$path.tmp");
autoconfig.cgi:1248: open (my $path_fh, '>', "$path.dat");
autoconfig.cgi:1250: open (my $path_txt_fh, '<',
"$path.txt");
autoconfig.cgi:1254: open (my $path_tmp_fh, '>',
"$path.txt");
ss_files/SurfDB.pm:85: open ($fh, '>>',
"$ddir/$db.txt");
ss_files/SurfDB.pm:100: open (my $fh, '>>', "$ddir/$db.tmp");
ss_files/SSLib.pm:100: open (my $auth_fh, '>', $auth_path);
ss_files/SSLib.pm:122: open (my
$auth_fh, '>', $auth_path);
ss_files/SSLib.pm:145: open (my $auth_fh, '>', $auth_path);
ss_files/SSLib.pm:927: open (my $order_lock, '>>',
"$path.lock");
ss_files/SSLib.pm:929: open (my $order_id, '>',
"$path.txt");
ss_files/SSLib.pm:937: open (my $order_lock, '>>', "$path.lock");
ss_files/SSLib.pm:939: open (my $order_id, '<', "$path.txt");
ss_files/SSLib.pm:946: open ($order_id, '>', "$path.txt");
ss_files/SSLib.pm:1137: open (my $countries, '<',
"$main::global->{'ddir_id'}/data/countrycodes.dat");
admin.cgi:497: open (my $IIF, '>', $1);
useradmin.cgi:76:open (my $users_fh,
"$main::global->{'ddir_id'}/data/.private/.p");
useradmin.cgi:87:open ($users_fh, '<',
"$main::global->{'ddir_id'}/data/.private/.auth");
useradmin.cgi:151:open ($users_fh, '>', $path);
autoconfig.cgi:1060: open (my $timezones_fh, '<',
"$main::global->{'ddir'}/data/timezones.js")
autoconfig.cgi:1061: or warn "Can't open timezone.js file
- $!";
ss_files/Validator.pm:541: open (my $lower_fh, '<',
'ss_files/acronyms/lower.txt') or warn "Cannot open lower.txt file: $!";
ss_files/Validator.pm:549: open (my $title_fh, '<',
'ss_files/acronyms/title.txt') or warn "Cannot open title.txt file: $!";
ss_files/Validator.pm:556: open (my $upper_fh, '<',
'ss_files/acronyms/upper.txt') or warn "Cannot open upper.txt file: $!";
You are opening files without verifying that they opened correctly or
posting a warning but still using the filehandle.
You also don't verify other file system functions like chmod() and unlink().
admin.cgi:966: return 0 unless (-e $server_datafile && -r _ && open (my
$cfg, '>', $server_datafile));
autoconfig.cgi:813: return 0 unless (-e $server_datafile && -r _ &&
open(my $cfg, '>', $server_datafile));
log_notification.pl:103: return 0 unless (-e $config_file && -r _
&& open(my $cfg, '<', $config_file));
ss_files/SSLib.pm:2934: return 0 unless (-e $server_datafile && -r _ &&
open(my $cfg, '<', $server_datafile));
ss_files/SSLib.pm:2948: return 0 unless (-e $server_datafile && -r _ &&
open(my $msgs, '<', $server_datafile));
ss_files/Validator.pm:820: return 1 unless (-e $datafile && -r _ &&
open(my $postal_fh, '<', $datafile));
You are using stat() on a file and then trying to open() it. stat()ing
the file first is unnecessary and a race condition. You should just try
to open() the file like this:
return 0 unless open my $cfg, '>', $server_datafile;
Or this:
open my $cfg, '>', $server_datafile or return 0;
ss_files/Validator.pm:623: if ($1 && $2 && $3) { # if above
pattern matches the regex...
ss_files/Validator.pm:624: return my $formatted =
"$1-$2-$3"; # xxx-xxx-xxxx
ss_files/Validator.pm:625: } else {
The variable $formatted is created on line 624 and then goes out of
scope on line 625. IOW it is superfluous.
autoconfig.cgi:727: my $selected = ' selected' if $hours ==
$main::global->{'config'}->{'serverOffsetHrs'};
ss_files/SSLib.pm:353: my @namevalues = split(/\&/, $form_string) if
(defined $form_string);
This was pointed out last time that the use of my() on the left side of
a statement modifier will produce undefined behavior. You even copied
the relevant entry from perlsyn into one of your files.
ss_files/Surf.pm:230: $source =~ tr /[a-m][n-z]/[n-z][a-m]/; #
performs rot13 swapping (lc)
ss_files/Surf.pm:231: $source =~ tr /[A-M][N-Z]/[N-Z][A-M]/; #
performs rot13 swapping (caps)
ss_files/Surf.pm:232:# ROT13 is usually coded as
tr/a-zA-Z/n-za-mN-ZA-M/. The '[' and ']' characters are unnecessary.
ss_files/SSLib.pm:2160: $rel =~ tr/[a-zA-Z0-9\-]//cd;
You are still unnecessarily using '[' and ']' with tr///.
autoconfig.cgi-742-#################
autoconfig.cgi-743- Surf::cl("$main::global->{'ddir'}/data/.p") =~
/(.*)/;
autoconfig.cgi-744- Surf::cl("$main::global->{'ddir'}/data/config.dat")
=~ /(.*)/;
autoconfig.cgi-745- my $path = $1;
autoconfig.cgi:746:# $path will be assigned a value from either of the
above lines, or from the last successful pattern match.
autoconfig.cgi-747-# Only use the results from capturing parentheses if
you know that the pattern matched successfully.
autoconfig.cgi-748-#################
You didn't fix the problem but you did copy the stuff I wrote last year
into your file. You could do it like this:
my ( $path ) = Surf::cl( "$::global->{ddir}/data/config.dat" ) =~ /(.*)/;
Strange Idioms, and Other WTF Moments:
ss_files/SurfDB.pm:43: 1 if
(Surf::cl("$self->{'DATADIR'}/$self->{'DB'}") =~ m|(.+)\/(\w+)|);
ss_files/SurfDB.pm:439: 1 if (Surf::cl($path) =~
m|(.+)\/(\w+?)\.\w+$|); # untaints file path for safe I/O operations
ss_files/SurfDB.pm:781: 1 if
(Surf::cl("$self->{'DATADIR'}/$self->{'DB'}") =~ m|(.+)\/(\w+)|);
ss_files/SurfDB.pm:1257: 1 if
(Surf::cl("$self->{'DATADIR'}/$self->{'DB'}") =~ m|(.+)\/(\w+)|);
As I said before:
1 if EXPRESSION;
Is a weird way of saying:
EXPRESSION;
forceorder.cgi:28:my ($dd, $null, $buffer, $configpath, $chomp,
$variable, $value, $omsg, $check, $command) = ();
forceorder.cgi:147: my ($info, $ct, $ctcounter, $old_item, $key) = ();
forceorder.cgi:202: my ($info, $namevalue, $name, $value, $referer) = ();
forceorder.cgi:215: my ($shipamt, $calculation, $from_page, $domains,
$line, $page_string, @payloads, $payload, $add,
@adds, $inclusive, $repl, $field, $tokenvalue, $type,
$search_tag, $tag, $replace_tag,
$uid_string, $hidden, $name, $calc, $bskt_string, %item,
$count, $cat_field,
$this_item, $thisloop, $cartitem, %hazardous, $hazardous,
$shiptotals, @newcalcs) = ();
forceorder.cgi:312: my ($match, $coupon, @coupons, @temp) = ();
forceorder.cgi:324: my ($key, $field, $thisrecord, $thisdata,
@fielddata, @newrecord, $matchrecord, %array,
@cats, @categories, $categories) = ();
forceorder.cgi:352: my ($out,$mode) = ();
forceorder.cgi:379: my ($capture, $error, $match, $record, $coupon,
@couponcats, $couponcat, $cat, $amt, $validpurchase) = ();
forceorder.cgi:406: my (@carts, $replace, $field, $key, $record,
$uidstr, $cart, $cartname, @stat, $test_time, $counter) = ();
forceorder.cgi:512: my ($subject, $mailmsg, $mail_host, $sender,
$sender_name, $receiver, $bcc, $recipient, $recipients, @recipient,
$return_path, $content
_type) = ();
forceorder.cgi:611: my ($bskt_string, @payloads, $payload, %item,
$count, $cat_field, $tag, $replace_tag, $counter, $thisloop, $cartitem,
@key) = ();
shop.cgi:39:my ($dd, $null, $buffer, $variable, $value, $omsg, $check,
$key, $giftcert) = ();
shop.cgi:392: my ($tempfile, $printfile) = ();
shop.cgi:586: my (@data, $test, $field, $thisrecord, @fieldnames) = ();
shop.cgi:677: my ($old_item, $key) = ();
shop.cgi:705: my ($namevalue, $name, $value, $referer) = ();
shop.cgi:736: my ($checkbox, $reqct, @required) = ();
shop.cgi:765: my ($del, $cat_item, @cat_item, %cat_item, $option, $key,
@optionstr, $optstr, $options, $new, $qty, %newitem, $cartitem, @items,
$data, $option
price, $open, $null) = ();
shop.cgi:768: my @id = ();
shop.cgi:830: my ($shipamt, $calculation, $from_page, $domains, $line,
$page_string, @payloads, $payload, $add, @adds, $inclusive, $repl,
$field, $tokenvalue,
$type, $search_tag, $tag, $replace_tag, $uid_string, $hidden, $name,
$calc, $key, $bsktstring, %item, $count, $cat_field, $counter,
$this_item, $thisloop, $car
titem, @newcalcs) = ();
shop.cgi:956: my @methods = ();
shop.cgi:1040: my ($this, $new, $UID, $desc, $option, $qty,
$formdata, @info, $form_element, $this_item) = ();
shop.cgi:1068: my ($capture, $error, $match, $record, $coupon,
@couponcats, $couponcat, $cat, $amt, $validpurchase) = ();
shop.cgi:1093: my ($match, $coupon, @coupons, @temp) = ();
shop.cgi:1120: my ($payload, $file, %item, $item, $count,
$proceed, $done) = ();
shop.cgi:1179: my ($key, $field, $thisrecord, $thisdata,
@fielddata, @newrecord, $matchrecord, %array, @cats, @categories,
$categories) = ();
shop.cgi:1204: my ($out, $mode) = ();
shop.cgi:1270: my ($index, $pass) = ();
shop.cgi:1303: my ($field, $key, $record, $uidstr, $cartname,
@stat, $test_time) = ();
shop.cgi:1321: my ($this,$key) = ();
shop.cgi:1366: my ($key) = ();
autoconfig.cgi:30:my ($domain, $storestr, $exists, $buffer, @stores,
$store) = ();
autoconfig.cgi:63:my ($value, $variable, $chomp, @dirs, $dir, @files,
$file, $keywords, $string, $meta, $description, $thisdir, $title, $url,
$omsg) = ();
autoconfig.cgi:827: my (@dirs, @files, $dir, $file) = ();
autoconfig.cgi:946: my @dirs = ();
autoconfig.cgi:1205: my ($file, @not, $string, $path) = ();
autoconfig.cgi:1230: my (@fields, %hash, $db, $file, @data, $dtname,
$key, $keystr, $fields, $upgrade) = ();
autoconfig.cgi:1289: my ($index, $pass) = ();
ss_files/Validator.pm:15: my ($error, $charset, $form_field, @this,
$value1, $value2, $charType, $operator, $zip_test, @bad_data,
$test_string, $this_count, $field, $err_message,
$capitalize) = ();
ss_files/Validator.pm:634: my ($num, $this, $prod, $ones, $sum, $i,
@out) = ();
ss_files/Validator.pm:673: my ($req, @req) = ();
ss_files/SurfDB.pm:147: my (%sortby, $column, $matches, @sort,
@value, @range, @match_and, $total, @match_or, @terms, @xterms, $grp,
@sums) = ();
ss_files/SurfDB.pm:148: (%$column, @$matches) = (); # set up results
arrays.
ss_files/SurfDB.pm:205: my ($match, $check,
$sortstr, @vals, $vals) = ();
ss_files/SurfDB.pm:500: my ($line, $bytes, @data, @newfields) = ();
ss_files/SurfDB.pm:546: my %hash = ();
ss_files/SurfDB.pm:599: my @new = ();
ss_files/SurfDB.pm:748: my @repl = ();
ss_files/SurfDB.pm:792: my ($line, $key) = ();
ss_files/SurfDB.pm:831: my ($this, $that, @record, @record2) = ();
ss_files/SurfDB.pm:914: my @record = ();
ss_files/SurfDB.pm:957: my @part = ();
ss_files/SurfDB.pm:1061: my ($terms, @terms, @relterms, @xterms,
@fulltext, @ors, @clause, $out, $qry, $counter, $total, $column, @sums)
= ();
ss_files/SurfDB.pm:1088: my ($eq, $val) = ();
ss_files/SurfDB.pm:1205: my @queries = ();
ss_files/SurfDB.pm:1229: my @fields = ();
ss_files/SurfDB.pm:1293: my %sum = ();
ss_files/Emailer.pm:17: my ($mailbag, $others, @recipients,
$mail_host, $sender, $sender_name,
$receiver, $bcc, $return_path, $subject, $time_stamp,
$content_type) = ();
ss_files/Surf.pm:25: my ($ref, $check) = ();
ss_files/Surf.pm:50: my ($cookie_flag, $cookie, $value) = ();
ss_files/SSLib.pm:47: my ($user, $null, $crypt, $ok, $number, $ip,
$host, @d, @ids, %curr, $access, $time, $usr) = (); # $d,
ss_files/SSLib.pm:255: my %formdata = ();
ss_files/SSLib.pm:352: my ($name, $value) = (); # , $namevalue
ss_files/SSLib.pm:470: my ($name, $value) = ();
ss_files/SSLib.pm:516: my (%replace, @thisgroup, $search_string,
$bgcolor, @indexmatches, $replace_string, %out, $thisfield, $show, $key,
$orderlookup, %matchkey, $matchkey, $uid, $null, @outdata, $links,
$new_count, $p, $this_page, $field, $matches, $column, $open, $pages,
$next, $prev, $col_count, $repl, $temp_row, @fieldnames, @field_data,
$counter, $this_row, $maxrelevance, $widow) = ();
ss_files/SSLib.pm:741: my (@tr, @td, $cells, @trows) = ();
ss_files/SSLib.pm:744: my @tables = ();
ss_files/SSLib.pm:1045: my ($span, $width, @cols) = (); # $row,$col,
ss_files/SSLib.pm:1180: my ($wholesale, $mid, @prices, $replace_tag,
$last_break, $break, $price, $members) = (); # $this_price,
ss_files/SSLib.pm:1306: my (@list, $opt, $popup, @options, $replace_tag,
$name, $addtl, $msg, $low, $high) = (); # $this_option, $option
ss_files/SSLib.pm:1355: my @rows
= ();
ss_files/SSLib.pm:1423: my (@list, $out, $options) = (); # , $file
ss_files/SSLib.pm:1447: my (@out, $opt, $label, $out) = (); # , $option
ss_files/SSLib.pm:1467: my ($pref, $symbol, @data, %data, $record,
@list, $out, $options, $thisfield) = (); # $dat,
ss_files/SSLib.pm:1543: my ($change, $minibasket, @minibasket, %item,
$replloop, $thisloop, $adjust, $this_calculation, $item, $null,
$bgcolor, $close, $totals, $open) = (); # $this_item, $calc,
ss_files/SSLib.pm:1550: my ($rec, $null) = ();
ss_files/SSLib.pm:1555: my ($ct, $options) = ();
ss_files/SSLib.pm:1824: my ($not, $formfield, $op) = ();
ss_files/SSLib.pm:1941: my ($page, $line) = ();
ss_files/SSLib.pm:1983: my ($shipamt, $calculation, $from_page,
$domains, $line, $output, @payloads, $payload, $add, @adds, $inclusive,
$repl, $field, $tokenvalue, $type, $search_tag, $tag, $replace_tag,
$uid_string, $hidden, $name, $calc, $key) = ();
ss_files/SSLib.pm:2093: my @related = ();
ss_files/SSLib.pm:2114: my ($open, $out) = ();
ss_files/SSLib.pm:2138: my (@rel, %item, $item, $uid, $itemid,
$options, $qty, $other, %related, @these, $open) = ();
ss_files/SSLib.pm:2173: my ($key, $out, $loop) = ();
ss_files/SSLib.pm:2199: my (@payloads, $payload, %item, $count,
$cat_field, $tag, $replace_tag, $bskt_string, $counter, $thisloop) = ();
# , $cartitem
ss_files/SSLib.pm:2254: my ($stateprov, $country, $code, $sel,
$countries, @countries, @stateprov) = ();
ss_files/SSLib.pm:2368: my ($change, @prices, @data, $fieldname, $price,
$break, $wholesale, $thisoption, $cartitem, $member) = (); # $this_price,
ss_files/SSLib.pm:2472: my ($this, $option, @rows, $name, @value,
$value, $price, $optionprice, @out, $optionstr, $test, $open, $missing,
$addtl) = ();
ss_files/SSLib.pm:2555: my ($yr, $month, $date, $time) = ();
ss_files/SSLib.pm:2614: my (%fields, $symbols, $symbol, $string,
$fields, $grpkey, $char, $hier, $pref) = ();
ss_files/SSLib.pm:2654: my (%sort, %list, @tiers,
$tier, $css, $parent, $this, $base) = ();
ss_files/SSLib.pm:2658: my @hier = ();
admin.cgi:37:my ($dd, $null, $buffer, $configpath, $chomp, $variable,
$value, $omsg, $check, $command) = ();
admin.cgi:227: my ($key, $field, $thisrecord, $thisdata,
@fielddata, @newrecord, $matchrecord, %out, @cats, @categories,
$categories, $open) = ();
admin.cgi:253: my ($old, $mode) = ();
admin.cgi:357: my @new = ();
admin.cgi:394: my ($uid, $object, $key, $done, $pref, $field,
$nextuid, $categories, $time,
%change, @newrecord, @thisrecord, $thisdata,
$newrecord, $next, @categories, @cats, %data) = ();
admin.cgi:402: my %replace = ();
admin.cgi:488: my ($field, $symbol, $delim, $record, @newrecord,
@record, $data, $dfmt, $open, $database) = ();
admin.cgi:563: my ($countries, $options, $file, $option, $page,
$country, $code, @popup) = ();
admin.cgi:749: my ($hash, $newtext, $newQBtext, $count, $istax) = ();
admin.cgi:882: my (@data, $match, $field, $symbol, $record) = ();
admin.cgi:924: my ($cell, $totalcells, $count, $counter, %cell) = ();
useradmin.cgi:32:my ($dd, $null, $buffer, $configpath, $chomp,
$variable, $value, $omsg, $check, $command) = ();
The weird idiom here is:
my LIST/ARRAY/HASH = ();
my() creates new variables that are empty so the assignment makes little
sense.
Another problem is that many of those variables are never used, or are
created at the wrong scope, or are used but are not really needed.
admin.cgi:296: ($null) = SSLib::return_minibasket('',
$old, $data);
forceorder.cgi:183: my ($rec, $null) =
SSLib::join_cart_item($item, $cartitem, '|');
forceorder.cgi:371: ($null) = SSLib::return_minibasket('', $out,
$data);
shop.cgi:348: my ($rec, $null) =
SSLib::join_cart_item($item, $cartitem, '|');
shop.cgi:587: my ($null, $uid, $user, $pass, $time) = split(/%%/,
Surf::Decrypt($main::global->{'cookies'}->{"$main::global->{'form'}->{'storeid'}_ud"},
$main::global->{'config'}->{'sbcookie'}));
shop.cgi:782: ($main::global->{'cart'}->{$cartitem}, $null) =
SSLib::join_cart_item(SSLib::modify_cart_item('add',
abs(int($main::global->{'form'}->{$id})),
$main::global->{'cart'}->{$cartitem}), $cartitem);
shop.cgi:815:
($main::global->{'cart'}->{$main::global->{'cartcounter'}}, $null) =
SSLib::join_cart_item($tempitem, $main::global->{'cartcounter'});
shop.cgi:825: ($main::global->{'cart'}->{$cartitem}, $null) =
SSLib::join_cart_item(SSLib::modify_cart_item('modify',
abs(int($main::global->{'form'}->{$id})),
$main::global->{'cart'}->{$cartitem}), $cartitem) if (defined
($main::global->{'cart'}->{$cartitem}));
shop.cgi:1049: my $null = chr(0);
shop.cgi:1052: $main::global->{'userinfo'}->{$form_element} =~ s/$null//g;
ss_files/SurfDB.pm:732: my $null =
pop(@cats);
ss_files/SurfDB.pm:759: my $null =
pop(@cats);
ss_files/Multipart.pm:22: my($null) = '';
ss_files/Multipart.pm:23: $length -= read(*STDIN, $null,
length($boundary) + 2, 0);
ss_files/SSLib.pm:82: ($usr, $crypt, $time, $null) =
split(/%%/,
Surf::decode_base_64($main::global->{'cookies'}->{$main::global->{'config'}->{'sbcookie'}}));
ss_files/SSLib.pm:90: ($user, $null) = split (/\t/,
$curr);
ss_files/SSLib.pm:136: ($user, $crypt, $time, $null) = split(/%%/,
Surf::decode_base_64($main::global->{'cookies'}->{$main::global->{'config'}->{'sbcookie'}}));
ss_files/SSLib.pm:199: if ($ENV{'SCRIPT_NAME'} =~ /autoconfig/) {
ss_files/SSLib.pm:200: my ($url, $hidden) =
get_url(keys(%{$main::global->{'form'}}));
ss_files/SSLib.pm:201: print $hidden ;
ss_files/SSLib.pm:202: }
ss_files/SSLib.pm:1522: my ($null, $conversion, $precisiond) = split
(/:/, $prec);
ss_files/SSLib.pm:1568: ($null, $item) =
join_cart_item(modify_cart_item('modify', $parts[1], $this_item, '',
$parts[6], $parts[7], $parts[8]), $count);
ss_files/SSLib.pm:1572: ($null, $item) =
join_cart_item($item, $count, '|', $this_item);
ss_files/SSLib.pm:1633: ($rec, $null) = join_cart_item($item,
$count, '|');
ss_files/SSLib.pm:2178:# my ($null, $item) =
join_cart_item({}, '', '', $main::global->{'wish'}->{$key});
ss_files/SSLib.pm:2206: my ($null, $item) = join_cart_item('',
'', '', $main::global->{'cart'}->{$cartitem});
ss_files/SSLib.pm:2373: ($null, $item) = join_cart_item('', '',
'', $data) ;
autoconfig.cgi:935: my ($usr,
$other) = split (/\t/, $this);
shop.cgi:1247: my ($uname, $other) = split (/\@/,
$main::global->{'userinfo'}->{'Ecom_BillTo_Online_Email'});
ss_files/SSLib.pm:898: ($key, $qty, $itemid, $other) = split
(/\t/, $cart->{$key});
ss_files/SSLib.pm:2146: ($uid, $itemid, $options, $qty,
$other) = split (/\t/, $main::global->{'cart'}->{$item});
ss_files/SSLib.pm:2464: my ($id, $qty, $itemid, $other) = split
(/\t/, $main::global->{'cart'}->{$cartitem});
$null, $other and $dd are three examples of variables that are not
needed. For example:
($null) = SSLib::return_minibasket('', $old, $data);
my $null = pop(@cats);
Should be just:
SSLib::return_minibasket('', $old, $data);
pop(@cats);
If the right hand side of a list is not wanted
($user, $crypt, $time, $null) = split( /%%/, Surf::decode_base_64(
$main::global->{'cookies'}->{ $main::global->{'config'}->{'sbcookie'}}));
You can just omit it:
($user, $crypt, $time) = split( /%%/, Surf::decode_base_64(
$main::global->{'cookies'}->{ $main::global->{'config'}->{'sbcookie'}}));
If the unwanted elements are in the middle or left hand side of the list:
($null, $item) = join_cart_item('', '', '', $data) ;
Then you could use undef as a place holder:
(undef, $item) = join_cart_item('', '', '', $data) ;
autoconfig.cgi-932- while (<$pass1_fh>) {
autoconfig.cgi:933: my $this = $_;
forceorder.cgi:154: while (<$cart_fh>) {
forceorder.cgi:155: $old_item = $_;
shop.cgi-684- while (<$cart_fh>) {
shop.cgi:685: $old_item = $_;
shop.cgi-1324- while (<$wish_fh>) {
shop.cgi:1325: $this = $_;
ss_files/SurfDB.pm-516- while (<$out_path_fh>) {
ss_files/SurfDB.pm:518: my $line = $_;
ss_files/SSLib.pm-87- while (<$auth_fh>) {
ss_files/SSLib.pm:88: my $curr = $_;
useradmin.cgi-78-while (<$users_fh>) {
useradmin.cgi:79: my $this = $_;
useradmin.cgi-88-while (<$users_fh>) {
useradmin.cgi:89: my $this = $_;
while (<$users_fh>) {
my $this = $_;
Is usually written as:
while (my $this = <$users_fh>) {
forceorder.cgi-425- for ($main::global->{'form'}->{scount} ..
$main::global->{'form'}->{scount} + $main::global->{'form'}->{show}) {
forceorder.cgi:426: $counter = $_;
ss_files/SurfDB.pm-319- for ($cursor .. $cursor + $show - 1) {
ss_files/SurfDB.pm:320: my $this = $_;
ss_files/SurfDB.pm-1188- for ($cursor .. $cursor + $show
- 1) {
ss_files/SurfDB.pm:1189: $counter = $_;
for ($cursor .. $cursor + $show - 1) {
my $this = $_;
Is usually written as:
for my $this ($cursor .. $cursor + $show - 1) {
forceorder.cgi:205: foreach $namevalue (split(/&/, $line)) {
autoconfig.cgi:726: for $hours (0..23) {
You forgot to put my() in front of $namevalue and $hours.
ss_files/SSLib.pm:2387: return \%{$item};
ss_files/SSLib.pm:2458: return \%{$item};
You have a hash reference stored in $item, but instead of returning it
you dereferenced it and return a reference to that dereferenced hash.
$ perl -le'my $item = {}; print for $item, \%{$item}'
HASH(0x83e9818)
HASH(0x83e9818)
As you can see the values for both are the same.
forceorder.cgi:221: %{$shiptotals} = ();
shop.cgi:845: my (%hazardous, $hazardous, $shiptotals);
shop.cgi:846: %{$shiptotals} = ();
ss_files/SurfDB.pm:40: my $self = {};
ss_files/SurfDB.pm:41: %{$self} = @_;
ss_files/SurfDB.pm:343: %{$change} = ();
ss_files/SurfDB.pm:413: %{$hash} = ();
ss_files/SurfDB.pm:1177: @{$out} = ();
ss_files/SurfDB.pm:1288: else {%{$self->{'DATA'}} = ();}
ss_files/SSLib.pm:883: @{$trows} = ();
You are dereferencing hashes and arrays to clear then
%{$hash} = ();
@{$out} = ();
When you could just clear the scalar variable
$hash = {};
$out = [];
And this example:
my $self = {};
%{$self} = @_;
Couls be done in one step:
my $self = {@_};
autoconfig.cgi:110:my $main_domain = @{$main::global->{'referers'}}[0];
That should be:
autoconfig.cgi:110:my $main_domain = $main::global->{'referers'}[0];
ss_files/Surf.pm:42: my $s1 = @chr[int(rand($#chr + 1))];
ss_files/Surf.pm:43: my $s2 = @chr[int(rand($#chr + 1))];
You are using an array slice improperly:
ss_files/Surf.pm:42: my $s1 = $chr[ rand @chr ];
ss_files/Surf.pm:43: my $s2 = $chr[ rand @chr ];
forceorder.cgi:429: my $info;
forceorder.cgi:430: %{$info} = split (/%%/,$carts[$counter - 1]);
That should be:
forceorder.cgi:429: my $info = { split /%%/, $carts[ $counter - 1
] };
admin.cgi:234: map { $data->{$_} = $hash->{$_} }
@{$main::global->{'open'}->{$database}->{'FIELDNAMES'}};
admin.cgi:241: map { $data->{$_} = $hash->{$_} }
('orderid','orderstatus','lastmod','tracking1','comments');
autoconfig.cgi:167: map { $main::global->{'config'}{$_} =
form_value_encode($main::global->{'config'}{$_}); } keys
%{$main::global->{'config'}};
forceorder.cgi:330: map { $data->{$_} = $hash->{$_} }
@{$main::global->{open}->{$database}->{'FIELDNAMES'}};
shop.cgi:1184: map { $data->{$_} = $hash->{$_} }
@{$main::global->{open}->{$database}->{'FIELDNAMES'}};
ss_files/SSLib.pm:2380: map { $item->{$_} = $this->{$_} } keys
%{$this};
ss_files/SurfDB.pm:414: map {$hash->{$_} = shift @data }
@{$self->{'FIELDNAMES'}};
ss_files/SurfDB.pm:818: map { $hash->{$_} = shift @record }
@{$self->{'FIELDNAMES'}} ;
You are using map in void context.
Something like:
map {$hash->{$_} = shift @data } @{$self->{'FIELDNAMES'}};
Could be (using slices) written as:
@{ $hash }{ @{ $self->{ FIELDNAMES } } } = @data;
admin.cgi:59:$main::global->{'form'}->{'storeid'} = '1' unless
($main::global->{'form'}->{'storeid'}); # defaults to '1'
admin.cgi:86:$main::global->{'config'}->{'ssl_port'} = 443 unless
($main::global->{'config'}->{'ssl_port'});
admin.cgi:125:$main::global->{'form'}->{'c'} = 'welcome.htm' unless
($main::global->{'form'}->{'c'});
autoconfig.cgi:75:$main::global->{'config'}->{'OnErrorFile'} =
'stderr.htm' unless ($main::global->{'config'}->{'OnErrorFile'});
autoconfig.cgi:76:$main::global->{'config'}->{'expire'} = 60 unless
($main::global->{'config'}->{'expire'});
autoconfig.cgi:77:$main::global->{'config'}->{'prunecart'} = 7 unless
($main::global->{'config'}->{'prunecart'});
autoconfig.cgi:78:$main::global->{'config'}->{'ssl_port'} = 443
unless ($main::global->{'config'}->{'ssl_port'});
autoconfig.cgi:79:$main::global->{'config'}->{'sqlhost'} =
'localhost' unless ($main::global->{'config'}->{'sqlhost'});
autoconfig.cgi:80:$main::global->{'config'}->{'sqltype'} = 'mysql'
unless ($main::global->{'config'}->{'sqltype'});
autoconfig.cgi:81:$main::global->{'config'}->{'mailprog'} =
'/usr/sbin/sendmail' unless ($main::global->{'config'}->{'mailprog'});
autoconfig.cgi:82:$main::global->{'config'}->{'root'} =
$ENV{'DOCUMENT_ROOT'} if (! $main::global->{'config'}->{'root'});
autoconfig.cgi:84:$main::global->{'config'}->{'timezone'} = 'UTC'
unless $main::global->{'config'}->{'timezone'};
autoconfig.cgi:85:$main::global->{'config'}->{'show_cart_on_add'} = 1
unless defined $main::global->{'config'}->{'show_cart_on_add'};
autoconfig.cgi:95: $main::global->{'config'}->{'secure_image'} =
$ENV{'HTTP_HOST'} if (! $main::global->{'config'}->{'secure_image'});
autoconfig.cgi:96: $main::global->{'config'}->{'secure_url'} =
"$ENV{'HTTP_HOST'}$cgi" if (! $main::global->{'config'}->{'secure_url'});
autoconfig.cgi:99: $main::global->{'config'}->{'image_url'} =
$ENV{'HTTP_HOST'} if (! $main::global->{'config'}->{'image_url'});
autoconfig.cgi:100: $main::global->{'config'}->{'cgi_location'} =
"$ENV{'HTTP_HOST'}$cgi" if (! $main::global->{'config'}->{'cgi_location'});
autoconfig.cgi:107:$main::global->{'config'}->{'domain'} =
"$ENV{'HTTP_HOST'}, $ENV{'SERVER_NAME'}" if (!
$main::global->{'config'}->{'domain'});
autoconfig.cgi:108:$main::global->{'config'}->{'homepage'} =
"http://$ENV{'HTTP_HOST'}" if (! $main::global->{'config'}->{'homepage'});
forceorder.cgi:42:$main::global->{'form'}->{'storeid'} = '1' unless
($main::global->{'form'}->{'storeid'}); # defaults to '1'
forceorder.cgi:50:$main::global->{'config'}->{'ssl_port'} = 443 unless
($main::global->{'config'}->{'ssl_port'});
forceorder.cgi:208: $info->{$name} = $value unless
($info->{$name}); # always use customer record, if different than cart
forceorder.cgi:550: $info->{'Content-Type'} = 'text/plain' unless
($info->{'Content-Type'});
shop.cgi:45:$main::global->{'form'}->{'storeid'} = '1' unless
($main::global->{'form'}->{'storeid'});
shop.cgi:63:$main::global->{'config'}->{'appfield'} = 'status' unless
($main::global->{'config'}->{'appfield'});
shop.cgi:64:$main::global->{'config'}->{'ssl_port'} = 443 unless
($main::global->{'config'}->{'ssl_port'});
shop.cgi:182:$main::global->{'user_uid'} = generate_uid() if (!
$main::global->{'user_uid'});
shop.cgi:712: $main::global->{'userinfo'}->{$name} =
$value unless ($main::global->{'userinfo'}->{$name}); # always use
customer record, if different than cart
shop.cgi:836: $main::global->{'form'}->{'Ecom_BillTo_Postal_StateProv'}
= $main::global->{'form'}->{'defaultstate'} unless
$main::global->{'form'}->{'Ecom_BillTo_Postal_StateProv'};
shop.cgi:837: $main::global->{'form'}->{'Ecom_ShipTo_Postal_StateProv'}
= $main::global->{'form'}->{'defaultstate'} unless
$main::global->{'form'}->{'Ecom_ShipTo_Postal_StateProv'};
shop.cgi:974: $main::global->{'form'}->{'shiptype'} =
$cname if not $main::global->{'form'}->{'shiptype'};
shop.cgi:1301: $main::global->{'config'}->{'prunecart'} = 7 if (!
$main::global->{'config'}->{'prunecart'}); # default time 7 days
useradmin.cgi:39:$main::global->{'form'}->{'storeid'} = '1' unless
($main::global->{'form'}->{'storeid'}); # defaults to '1'
useradmin.cgi:53:$main::global->{'config'}->{'ssl_port'} = 443 unless
($main::global->{'config'}->{'ssl_port'});
ss_files/SSLib.pm:153: $main::global->{'omsg'}->{'0'} = '<span
class="text-small"><b>' if (! $main::global->{'omsg'}->{'0'});
ss_files/SSLib.pm:520: $in_sortby = $main::global->{'form'}->{'sortby'}
if not $in_sortby;
ss_files/SSLib.pm:521: $database = $main::global->{'form'}->{'b'} if
not $database;
ss_files/SSLib.pm:549: $main::global->{'form'}->{'scount'} = 1 if
(!$main::global->{'form'}->{'scount'});
ss_files/SSLib.pm:1453: $label = $opt if (! $label);
ss_files/SSLib.pm:1468: $label = $field if (!$label);
ss_files/SSLib.pm:1683: $form->{'QBacct_coupon'} =
$out->{'coupontype'} ? "$out->{'coupontype'} Discounts" : 'Coupon
Discounts' unless ($form->{'QBacct_coupon'});
ss_files/SSLib.pm:1684: $form->{'QBinvitem_coupon'} =
$out->{'coupontype'} ? $out->{'coupontype'} : 'Coupon' unless
($form->{'QBinvitem_coupon'});
ss_files/SSLib.pm:1758: $form->{'shiptype'} = $calc if not
$form->{'shiptype'};
ss_files/SSLib.pm:2005: $template = 'main.htm' unless ($template);
ss_files/SSLib.pm:2044:
$main::global->{'form'}->{'Ecom_BillTo_Postal_StateProv'} =
$main::global->{'form'}->{'defaultstate'} unless
$main::global->{'form'}->{'Ecom_BillTo_Postal_StateProv'};
ss_files/SSLib.pm:2045:
$main::global->{'form'}->{'Ecom_ShipTo_Postal_StateProv'} =
$main::global->{'form'}->{'defaultstate'} unless
$main::global->{'form'}->{'Ecom_ShipTo_Postal_StateProv'};
ss_files/SSLib.pm:2081: $content_type = 'text/plain' unless
($content_type);
ss_files/SSLib.pm:2087: $count = 1 unless ($count);
ss_files/SSLib.pm:2119: $count = 1 unless ($count);
ss_files/SSLib.pm:2447: $item->{'unitprice'} =
$price unless $item->{'unitprice'};
ss_files/SSLib.pm:2486: $item->{'optionprice'} =
$addtl unless ($item->{'optionprice'});
ss_files/SurfDB.pm:315: $show = 10 unless ($show);
ss_files/SurfDB.pm:317: $cursor = 1 unless ($cursor);
ss_files/SurfDB.pm:323: $key = $sort unless ($key); #
in case Wildcards are used
ss_files/SurfDB.pm:429: $result = 'BAD PASSWORD' unless ($result);
ss_files/SurfDB.pm:635: $length = 1 unless ($length);
ss_files/SurfDB.pm:830: $replace = {} unless ($replace);
ss_files/SurfDB.pm:1168: $cursor = 1 unless ($cursor);
ss_files/SurfDB.pm:1169: $show = 10 unless ($show);
The idiom:
$variable = 'value' unless $variable;
$variable = 'value' if ! $variable;
$variable = 'value' if not $variable;
Could be written as:
$variable ||= 'value';
admin.cgi:154: $main::global->{'form'}->{'show_cart_on_add'} =
1 if not defined $main::global->{'form'}->{'show_cart_on_add'};
admin.cgi:155: $main::global->{'form'}->{'offline_mode'} = 0 if
not defined $main::global->{'form'}->{'offline_mode'};
admin.cgi:832: $main::global->{'form'}->{$checkbox} = '' if (!
defined($main::global->{'form'}->{$checkbox}) );
forceorder.cgi:369: $out->{'minibasket'} = $data->{'minibasket'}
unless (defined($out->{'minibasket'}));
shop.cgi:192: $main::global->{'form'}->{"modify_$cartitem"} =
$test[1] unless (defined ($main::global->{'form'}->{"modify_$cartitem"}));
shop.cgi:760: $main::global->{'form'}->{$checkbox} = '' if (!
defined($main::global->{'form'}->{$checkbox}) );
shop.cgi:793: $main::global->{'form'}->{"modify_$cartitem"} = $test[1]
unless (defined ($main::global->{'form'}->{"modify_$cartitem"}));
shop.cgi:798: $main::global->{'form'}->{"modify_$cartitem"} = $test[1]
unless (defined ($main::global->{'form'}->{"modify_$cartitem"}));
ss_files/SSLib.pm:1540: $form->{$field} = $out->{$field} unless
(defined ($form->{$field}));
ss_files/Surf.pm:153: $eol = "\n" unless defined $eol;
The idiom:
$variable = 'value' unless defined $variable;
$variable = 'value' if ! defined $variable;
$variable = 'value' if not defined $variable;
Could be written as:
$variable //= 'value';
ss_files/SSLib.pm:2812: $this_date = $this_date || $dt; ## WHAT DOES
THIS DO?
The same as:
$this_date = $dt unless $this_date;
See above.
ss_files/Multipart.pm:25: else {
ss_files/Multipart.pm:26: my($old);
ss_files/Multipart.pm:27: ($old, $/) = ($/,$crlf);
ss_files/Multipart.pm:31: $/ = $old;
ss_files/Multipart.pm:32: }
ss_files/SSLib.pm:1939: my $temp = $/;
ss_files/SSLib.pm:1940: $/ = undef;
ss_files/SSLib.pm:1948: $/ = $temp;
ss_files/SSLib.pm:1994: if (-f $from_page) {
ss_files/SSLib.pm:1995: my $temp = $/;
ss_files/SSLib.pm:1996: $/ = undef;
ss_files/SSLib.pm:2001: $/ = $temp;
ss_files/SSLib.pm:2002: }
ss_files/SurfDB.pm:90: my $temp = $/;
ss_files/SurfDB.pm:91: $/ = undef;
ss_files/SurfDB.pm:93: $/ = $temp;
ss_files/SurfDB.pm:497: my $temp = $/;
ss_files/SurfDB.pm:498: $/ = "\n";
ss_files/SurfDB.pm:573: $/ = $temp;
This idiom can be replaced with:
local $/; # $/ is now undef
Or:
local $/ = $crlf;
There is a problem in the following subroutine. If you know how hashes
work you should be able to figure it out.
admin.cgi:922:sub new_field {
admin.cgi:923: my ($names, $cols, $html, $current, $action) = @_;
admin.cgi:924: my ($cell, $totalcells, $count, $counter, %cell) = ();
admin.cgi:925: while ($current =~ m|(<!--//BEGINCELL
(.+?)//-->.*?<!--//ENDCELL .+?//-->)|sig) {
admin.cgi:926: $cell{$2} = $1;
admin.cgi:927: $totalcells++;
admin.cgi:928: }
admin.cgi:929: if ($action eq 'del') {
admin.cgi:930: foreach my $name (split (/, */ , $names)) {
admin.cgi:931: delete ($cell{$name});
admin.cgi:932: $totalcells--;
admin.cgi:933: }
admin.cgi:934: }
admin.cgi:935: else {
admin.cgi:936: foreach my $name (split (/, */ , $names)) {
admin.cgi:937: next unless ($name =~ /\w/);
admin.cgi:938: my $sortstr = substr("00$totalcells",
-2); # Pads $totalcells with 2 leading zeroes for non-HTML emails.
admin.cgi:939: $html =~ s~</td><td~</td>\n<td~g; # add
a new line between </td><td for cleaner HTML
admin.cgi:940: $cell{"$sortstr$name"} =
"<!--//BEGINCELL $name//-->\n$html\n<!--//ENDCELL $name//-->";
admin.cgi:941: $cell{"$sortstr$name"} =~
s/\[NAME\]/$name/sig;
admin.cgi:942: $totalcells++;
admin.cgi:943: }
admin.cgi:944: }
admin.cgi:945: ($counter, $count) = 0;
admin.cgi:946: $current = "\n"; # start off with a new line so HTML
looks cleaner
admin.cgi:947: foreach my $cell (sort keys (%cell)) {
admin.cgi:948: my $cell_name = substr ($cell, 2); # removes the 2
digit number from the beginning of $cell and leaves only the calc name
admin.cgi:949: next unless ($cell);
admin.cgi:950: $current .= "\n<! if:$cell_name:ne:0>\n" unless
($count); # adds an IF statement around custom calcs so they don't show
if = $0.00
admin.cgi:951: $current .= "$cell{$cell}\n";
admin.cgi:952: $count++;
admin.cgi:953: $counter++;
admin.cgi:954: if ($count >= $cols || $counter == $totalcells) {
admin.cgi:955: $count = 0;
admin.cgi:956: $current .= "<! /if>\n";
admin.cgi:957: }
admin.cgi:958: }
admin.cgi:959: $html =~ s|</td><td|</td>\n<td|g; # add a new line
between </td><td for cleaner HTML
admin.cgi:960: return
"<!--NEWFIELDSSTART($cols)--//$html//-->$current<!--NEWFIELDSEND-->";
admin.cgi:961:}
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/
