0byt3m1n1
Path:
/
data
/
17
/
1
/
18
/
11
/
1670011
/
user
/
1801231
/
htdocs
/
tanningonline_com
/
cgi-bin
/
ss
/
[
Home
]
File: regen.cgi
require "template.pl"; require "ssmparser.pl"; require "customparser.pl"; require "i18n.pl"; &plSSMsgCatOpen(USERCLASS_MERCHANT); $SSM_DEMO = 0; $SSM_STD = 1; $SSM_PRO = 2; $SSM_EXP = 3; $SSM_LIT = 4; ($DATA_DIR,$OUTPUT_DIR,$BO_DIR,$CGI_URL,$OUTPUT_URL,$STOREID,$PRODUCT_TYPE,$BUILDPAGES,$BUILDSMART,$VERSION,$OS_TYPE) = @ARGV; if ($] < 5.003) { printf STDOUT &plSSMsgCatGet(SSMSG00037, "<p>\n\ <b>\n\ WARNING!!! You are attempting to generate your store using\n\ Perl version %f. ShopSite requires at least Perl version 5.003\n\ in order to generate your store correctly.\n\ </b>\n\ <br>\n\ An attempt to generate your store will be made, but results\n\ cannot be guaranteed."), $]; } $OS_TYPE = (($OS_TYPE =~ /^IRIX/)|| ($OS_TYPE=~/^Solaris.*/))?"SOLARIS":$OS_TYPE; $currency = "USD|\$|-#,###\$##||"; $decimal = "."; $separator = ","; $altcurrency = ""; $currencyratio = ""; $locale = "en-US|latin1|.|,|lbs|%a %b %d %Y|%a %b %d %Y %I:%M:%S %p|%I:%M:%S %p"; $separatorcount=0; $precision=0; $currencyplacement=0; $filename = "$BO_DIR/$STOREID.aa"; if (open (STOREDATA, $filename)) { while ($line = <STOREDATA>) { ($field,$value) = split(/: /,$line,2); chomp($value); if ($field eq "currency") {$currency =$value;} if ($field eq "BuyerLocale") {$locale=$value;} if ($field eq "altcurrency") {$altcurrency=$value;} if ($field eq "currencyratio") {$currencyratio = $value;} } &initFormatting($currency, $altcurrency, $locale); close(STOREDATA); } else { printf STDOUT &plSSMsgCatGet(SSMSG00107, "<p><b>Problem opening %s<\b>"), $filename; } $filename = "$DATA_DIR/world.aa"; if (open (WORLD, $filename)) { $SearchCk = "x"; while ($line = <WORLD>) { ($field,$value) = split(/: /,$line); chop($value); if ($field eq "1str") {$Checkout =$value;} if ($field eq "0str") {$Order=$value;} if ($field eq "0old") {$Ordold=$value;} if ($field eq "86str") {$Search = $value;} if ($field eq "86old") {$Searchold = $value;} if ($field eq "86img") {$SearchImg = $value;} if ($field eq "86ck") {$SearchCk = $value;} if ($field eq "97str") {$Saletext = $value;} } if ($SearchCk eq "x") {$SearchCk = ""}; } else { printf STDOUT &plSSMsgCatGet(SSMSG00107, "<p><b>Problem opening %s<\b>"), $filename; } $filename = "$DATA_DIR/sbdata.aa"; if (open (SB, $filename)) { while ($line = <SB>) { ($field,$value) = split(/: /,$line); chop($value); if ($field eq "search_fld") {$Searchfld =$value;} } close(SB); } else { printf STDOUT &plSSMsgCatGet(SSMSG00107, "<p><b>Problem opening %s<\b>"), $filename; } if ($Order eq "") {$Order=$Orldold;} close(WORLD); if ($Search eq "") {$Search=$Searchold;} if ($Searchfld eq "") {$Searchfield="Bottom";} &NewDB("pages"); &NewDB("products"); $regenall = 0; @pagesupdate = (); @productsupdate = (); @realupdate = (); $updatefile = $DATA_DIR."/update.dat"; open(UPDATEF, $updatefile); while(<UPDATEF>) { if (/(\w*):(\d*)/) { if ($1 eq "pages") { push (@pagesupdate, $2); } elsif ($1 eq "products") { push (@productsupdate, $2); } } elsif (/Regenerate All/) { $regenall = 1; last; } elsif (/Full Regen/) { $regenall = 1; print STDOUT &plSSMsgCatGet(SSMSG00117, "Your store is now being regenerated."); print STDOUT &plSSMsgCatGet( SSMSGFlRegenWarning, "<br><b>Note:</b> Regenerate re-creates all your\n\ store's web pages whether you have changed them or not. Normally you do not\n\ need to use this utility after making changes to your store. Simply\n\ press the Publish tab in your ShopSite and only the pages that have been\n\ modified from your last update will be generated."); last; } } $didsmarthtml = 0; if (($PRODUCT_TYPE == $SSM_PRO) && ($BUILDSMART eq "on")) { local ($cwd); use Cwd; $cwd = getcwd(); $cwd .= "/" unless $cwd =~ /\/$/; chdir($OUTPUT_DIR); if (opendir(SMARTHTMLDIR, "./smarthtml")) { @smarthtmlfiles = grep(!/^\.\.?$/,readdir(SMARTHTMLDIR)); closedir(SMARTHTMLDIR); if ($#smarthtmlfiles!=-1) #This looks at the last element. { print STDOUT &plSSMsgCatGet(SSMSGCustPageFiles,"<br>Custom Pages files:\n<br>"); print STDOUT "@smarthtmlfiles\n"; $smartprogressfile = $DATA_DIR."/smartprogress.dat"; open(SMARTPROGRESSF, $smartprogressfile); while(<SMARTPROGRESSF>) { printf STDOUT &plSSMsgCatGet(SSMSG00122, "<br>%s already done\n"), $_; chop $_; push (@smartprogress, $_); } print "<br>"; close(SMARTPROGRESSF); $smartprogressfile = ">>".$smartprogressfile; open(SMARTPROGRESSF, $smartprogressfile); select SMARTPROGRESSF; $| = 1; $didsmarthtml = 1; &NewDB("pages"); while(&NextRecord == 1) { $pname = &Field('Name'); $pnum = $CUR_REC{'number'}; $PageList{$pname} = $pnum; } &EndNewDB; &NewDB("products"); while(&NextRecord == 1) { $pname = &Field('Name'); $pnum = $CUR_REC{'number'}; $ProductsList{$pname} = $pnum; } &EndNewDB; foreach $filename (@smarthtmlfiles) { $smartcheck = &smartdone($filename); if ($smartcheck == 0) { local($infile) = $filename; local($outfile) = $filename; $infile = "$OUTPUT_DIR/smarthtml/".$infile; $outfile = "$OUTPUT_DIR/".$outfile; &SmartParser($infile,$outfile); print SMARTPROGRESSF "$filename\n"; } } } } else { } chdir($cwd); } if ($BUILDPAGES) { $progressfile = $DATA_DIR."/progress.dat"; open(PROGRESSF, $progressfile); while(<PROGRESSF>) { push (@progress, $_); } close(PROGRESSF); $progressfile = ">>".$progressfile; open(PROGRESSF, $progressfile); select PROGRESSF; $| = 1; if (($#pagesupdate != -1 || $#productsupdate != -1) && !$regenall) { &NewDB("products"); while (&NextRecord == 1) { local($prodname) = &Field('Name'); local($prodnum) = $CUR_REC{'number'}; if (&IsIn($prodnum, "products")) { push (@realupdate, $prodnum); } else { local(@SUBPROD); $SUBPROD[0] = undef; $SUBPROD[1] = undef; @SUBPROD = &NextItem; local($numsubprods) = &GetItem(*CUR_DB, *CUR_REC); if ($numsubprods > 0) { do { if (&IsIn($SUBPROD[1], "products")) { push (@realupdate, $prodnum); } $SUBPROD[0]=undef; $SUBPROD[1]=undef; @SUBPROD = &NextItem; } while ($SUBPROD[0]); } } } &EndNewDB; @productsupdate = @realupdate; @realupdate = (); &NewDB("pages"); while (&NextRecord == 1) { local($pagename) = &Field('Name'); local($pagenum) = $CUR_REC{'number'}; if (&IsIn($pagenum, "pages")) { push (@realupdate, $pagenum); } else { local(@SUBITEM); $SUBITEM[0] = undef; $SUBITEM[1] = undef; @SUBITEM = &NextItem; local($numsubitems) = &GetItem(*CUR_DB, *CUR_REC); if ($numsubitems > 0) { $allreadydone = 0; do { if (&IsIn($SUBITEM[1], $SUBITEM[0])) { push (@realupdate, $pagenum); $allreadydone = 1; } $SUBITEM[0]=undef; $SUBITEM[1]=undef; @SUBITEM = &NextItem; } while ($SUBITEM[0] && !$allreadydone); } } } &EndNewDB; @pagesupdate = @realupdate; if ($#pagesupdate != -1) { &NewDB("pages"); while(&NextRecord == 1) { if (&IsIn($CUR_REC{'number'}, "pages")) { select NOFILE; $name = &Field('Name'); $newnum = $CUR_REC{'number'}; printf STDOUT &plSSMsgCatGet(SSMSG00126, "<p><b>Generating Page [%d:%s]...</b>\n"), $newnum, $name; &Emit( *CUR_DB, *CUR_REC, "PAGE" ); printf PROGRESSF "%d\n", $newnum; } } &EndNewDB; } else { print STDOUT &plSSMsgCatGet(SSMSG00127, "\n<br>No pages need updating."); } } elsif ($regenall) { print STDOUT &plSSMsgCatGet(SSMSG00128, "<p><b>Regen All.</b>") ; &NewDB("pages"); while(&NextRecord == 1) { if (&IsIn($CUR_REC{'number'}, "pages")) { select NOFILE; $newnum = $CUR_REC{'number'}; $name = &Field('Name'); printf STDOUT &plSSMsgCatGet(SSMSG00126, "<p><b>Generating Page [%d:%s]...</b>\n"), $newnum, $name; &Emit( *CUR_DB, *CUR_REC, "PAGE" ); printf PROGRESSF "%d\n", $newnum; } } &EndNewDB; } else { if (!$didsmarthtml) { print STDOUT &plSSMsgCatGet( SSMSGNoChanges, "\n<br>No changes were necessary. Your store is up to date."); } } } print STDOUT &plSSMsgCatGet(SSMSGFooterRegen, " <p> <b>Generation successful. You can now view your store.</b><br><hr> <i>Note: To view the latest changes you may need to <b>reload or refresh</b> the pages you view with your browser. <a href=\"tsplit.cgi?destination=reload\" target=\"SS.help\">Click Here</a> for instructions on how to configure your browser to always check for updated pages.</i> <hr> </body> </html> "); &EndNewDB; close(UPDATEF); unlink($updatefile); close(PROGRESSF); $progressfile = $DATA_DIR."/progress.dat"; unlink($progressfile); close(SMARTPROGRESSF); $smartprogressfile = $DATA_DIR."/smartprogress.dat"; unlink($smartprogressfile); $updatefile_i = $DATA_DIR."/update_i.dat"; unlink($updatefile_i); $progressfile_i = $DATA_DIR."/progress_i.dat"; unlink($progressfile_i); sub IsIn { local($rnum, $dbname) = @_; local($cnt); if ($regenall == 1) { if ($dbname eq "pages") { return &checkprogress($rnum); } else { return 1; } } if ($dbname eq "pages") { for ($cnt = 0; $cnt < @pagesupdate; $cnt++) { if ($pagesupdate[$cnt] == $rnum) { return &checkprogress($rnum); } } } if ($dbname eq "products") { for ($cnt = 0; $cnt < @productsupdate; $cnt++) { if ($productsupdate[$cnt] == $rnum) { return 1; } } } return 0; } sub checkprogress { local($num) = @_; for ($cnt = 0; $cnt < @progress; $cnt++) { if ($progress[$cnt] == $num) { printf STDOUT &plSSMsgCatGet(SSMSG00132, "\n<p>Skipping-Page %d was done earlier.\n<br>"), $num; return 0; } } return 1; } sub smartdone { local($sf) = @_; for ($cnt = 0; $cnt < @smartprogress; $cnt++) { if ($smartprogress[$cnt] eq $sf) { return 1; } } return 0; } sub AAGetToken { my($aafile, $key) = @_; my($value, $fullpath, $cwd, $script_filename, $script_name, $document_root, $field); $value = $AArrays{$aafile, $key}; if ($value) {return $value;} use Cwd; $cwd = getcwd(); $cwd .= "/" unless $cwd =~ /\/$/; $ENV{"SCRIPT_FILENAME"} =~ /^(.*)\/[^\/]*$/; $script_filename = $1; $ENV{"SCRIPT_NAME"} =~ /^(.*)\/[^\/]*$/; $script_name = $1; $document_root = $ENV{"DOCUMENT_ROOT"}; if ($aafile =~ /\//) { $fullpath = $aafile; } elsif ( -r $aafile ) { $fullpath = $aafile; } elsif ( -r "./$aafile" ) { $fullpath = "./$aafile"; } elsif ( -r "$cwd$aafile" ) { $fullpath = "$cwd$aafile"; } elsif ( -r "$script_filename/$aafile" ) { $fullpath = "$script_filename/$aafile"; } elsif ( -r "$script_name/$aafile" ) { $fullpath = "$script_name/$aafile"; } elsif ( -r "$document_root$script_name/$aafile" ) { $fullpath = "$document_root$script_name/$aafile"; chdir $fullpath;} open AA, $fullpath; while (<AA>) { ($field,$value) = split /: /; chomp($value); $AArrays{$aafile, $field} = $value; } close AA; chdir $cwd; return $AArrays{$aafile, $key}; } sub CalcSale { local($realprice, $saleamount) = @_; local($saleprice,$temp); if (!($saleamount =~ /.*\%.*/)) { return $saleamount; } $realprice =~ s/\,/\./; $saleamount =~ s/\,/\./; $saleamount =~ s/\%//; $saleamount *= .01; $temp = $realprice - ($realprice*$saleamount); $saleprice = sprintf "%1.2f", $temp; return $saleprice; } sub DoMoreInfo { if (!(-e "$OUTPUT_DIR/$filename") || (!(-M "$OUTPUT_DIR/$filename" <= 0) && (&IsIn($num, "products")) ) ) { $message = sprintf(&plSSMsgCatGet(SSMSGErrOpeningDirFile, "Error opening %s/%s"), $OUTPUT_DIR, $filename); &NewFile("$OUTPUT_DIR/$filename") || die $message; local($moreinfo_bgcolor); local($moreinfo_textcolor); local($moreinfo_linkcolor); local($moreinfo_vlinkcolor); local($moreinfo_alinkcolor); local($moreinfo_bgimage); local($moreinfo_header); local($moreinfo_footer); local($mitmp); $mitmp = AAGetToken("$DATA_DIR/moreinfodata.aa", "moreinfo_bgcolor"); if (!($mitmp =~ /\S+/)) { $mitmp = "FFFFFF"; } $moreinfo_bgcolor = $mitmp; $mitmp = AAGetToken("$DATA_DIR/moreinfodata.aa", "moreinfo_textcolor"); if (!($mitmp =~ /\S+/)) { $mitmp = "000000"; } $moreinfo_textcolor = $mitmp; $mitmp = AAGetToken("$DATA_DIR/moreinfodata.aa", "moreinfo_linkcolor"); if (!($mitmp =~ /\S+/)) { $mitmp = "0000FF"; } $moreinfo_linkcolor = $mitmp; $mitmp = AAGetToken("$DATA_DIR/moreinfodata.aa", "moreinfo_vlinkcolor"); if (!($mitmp =~ /\S+/)) { $mitmp = "FF0000"; } $moreinfo_vlinkcolor = $mitmp; $mitmp = AAGetToken("$DATA_DIR/moreinfodata.aa", "moreinfo_alinkcolor"); if (!($mitmp =~ /\S+/)) { $mitmp = "00FF--"; } $moreinfo_alinkcolor = $mitmp; $mitmp = AAGetToken("$DATA_DIR/moreinfodata.aa", "moreinfo_bgimage"); if (!($mitmp =~ /\S+/)) { $mitmp = "none"; } $moreinfo_bgimage = $mitmp; $moreinfo_header = AAGetToken("$DATA_DIR/moreinfodata.aa", "moreinfo_header"); $moreinfo_footer = AAGetToken("$DATA_DIR/moreinfodata.aa", "moreinfo_footer"); print <<SubProdOne; <html> <head> <title>$strippedname</title> </head> <body bgcolor="#$moreinfo_bgcolor" text="#$moreinfo_textcolor" link="#$moreinfo_linkcolor" vlink="#$moreinfo_vlinkcolor" alink="#$moreinfo_alinkcolor" SubProdOne if ($moreinfo_bgimage ne "none") { if ($moreinfo_bgimage =~ /^http:\/\/.*/) { print " background=\"$moreinfo_bgimage\" > "; } else { print " background=\"media/$moreinfo_bgimage\" > "; } } else { print " > "; } if ($moreinfo_header eq "checked") { &EmitFile("$DATA_DIR/uheader.dat"); } if ($CURALIGN eq "center") { print("<center>\n"); } local($moregraphic) = &Field('More information graphic'); if ((&Field('Display Graphic?') eq "checked") && ($moregraphic ne "none")) { if ($CURALIGN eq "right") { (($moregraphic =~ s/\balign="?(.*)"?\b/align=right/g) || ($moregraphic.=" align=right")); } elsif ($CURALIGN eq "left") { (($moregraphic =~ s/\balign="?(.*)"?\b/align=left/g) || ($moregraphic.=" align=left")); } print("<img $moregraphic >\n"); if ($CURALIGN eq "center") { print("<br>\n"); } } if ((&Field('Display Name?') eq "checked") && ($name)) { $name = &Field('Name'); print("\n<h2>$name</h2><br>\n"); } if ($moretext) { if ($descstyle eq "Bold") { $moretext = "<b>".$moretext."</b>"; } elsif ($descstyle eq "Italic") { $moretext = "<i>".$moretext."</i>"; } elsif ($descstyle eq "Typewriter") { $moretext = "<tt>".$moretext."</tt>"; } if ($descsize eq "Big") { $moretext = "<Big>".$moretext."</Big>"; } elsif ($descsize eq "Small") { $moretext = "<Small>".$moretext."</Small>"; } } local(@SUBITEMS2); $SUBITEMS2[0]=undef; $SUBITEMS2[1]=undef; &ResetRecord; @SUBITEMS2 = &NextItem; local($numitems) = &GetItem(*CUR_DB, *CUR_REC); if ($numitems > 0) { print ("\n<br>\n"); if ($moretext) { print ("$moretext\n<br>\n"); } do { if (!defined($SUBITEMS2[0]) || !defined($SUBITEMS2[1])) { last; } &NewDB( $SUBITEMS2[0] ); &SetRecord( $SUBITEMS2[1] ); if (&Field('Display Name?') eq "checked") { $subname = &Field('Name'); print("\n$subname "); } if (&Field('Display Price?') eq "checked") { $subprice = &Field('Price'); $subsaleon = &Field('Sale On'); $subsaleamount = &Field('Sale Amount'); if ($subprice) { $pstring = &pricestring($subprice); $pastring = &apricestring($subprice); if (($subsaleon eq "checked") && ($subsaleamount)) { $subsaleamount = &CalcSale($subprice,$subsaleamount); $spstring = &pricestring($subsaleamount); $spastring = &apricestring($subsaleamount); $subprice = "<strike>".$pstring."</strike>"; $subsaleamount = "<b>".$spstring."</b>"; print "\n$subprice $subsaleamount"; if ($pastring ne "") { $subprice = " <strike>".$pastring."</strike>"; $subsaleamount = "<b>".$spastring."</b>"; print "$subprice $subsaleamount"; } print(" $Saletext\n"); } else { print("$pstring "); if ($pastring ne "") { print(" $pastring "); } } } } if ($PRODUCT_TYPE == $SSM_PRO){ $SubOrderBtn = &Field('Order Button'); $SubCheckoutBtn = &Field('Checkout Button'); } else { $SubOrderBtn = $Order; $SubCheckoutBtn = $Checkout; } if ($SubOrderBtn ne ""){ print ("<a href=\"$CGI_URL/order.cgi?"); print ("storeid=$STOREID&dbname=${SUBITEMS2[0]}&"); print ("itemnum=${SUBITEMS2[1]}&function=add&super=$num\">$SubOrderBtn</a> "); } if ($SubCheckoutBtn ne ""){ print ("<a href=\"$CGI_URL/order.cgi?"); print ("storeid=$STOREID&dbname=${SUBITEMS2[0]}&"); print ("function=show\">$SubCheckoutBtn</a>\n"); } print("<br>"); &EndNewDB; $SUBITEMS2[0]=undef; $SUBITEMS2[1]=undef; @SUBITEMS2 = &NextItem; }while ($SUBITEMS2[0]); } else { if ((&Field('Display Price?') eq "checked") && ($price)) { $price = &Field('Price'); $pstring = &pricestring($price); $pastring = &apricestring($price); if (($saleon eq "checked") && ($saleamount)) { $saleamount = &Field('Sale Amount'); $saleamount = &CalcSale($price,$saleamount); $spstring = &pricestring($saleamount); $spastring = &apricestring($saleamount); $price = "<strike>".$pstring."</strike>"; $saleamount = "<b>".$spstring."</b>"; print "\n$price $saleamount"; if ($pastring ne "") { $price = " <strike>".$pastring."</strike>"; $saleamount = "<b>".$spastring."</b>"; print "$price $saleamount"; } print(" $Saletext<br>\n"); } else { print("\n<b>$pstring</b>"); if ($pastring ne "") { print(" <b>$pastring</b>"); } print("<br>\n"); } } if ((&Field('Display SKU?') eq "checked") && ($sku)) { print("\n$sku\n<br>\n"); } if ($moretext) { print ("\n<br>$moretext\n<br>\n"); } print ("<center>\n"); if ($OrderBtn ne "") { print ("<a href=\"$CGI_URL/order.cgi?"); print ("storeid=$STOREID&dbname=$CUR_DB{'name'}&"); print ("itemnum=$num&function=add\">$OrderBtn</a> "); } if ($CheckoutBtn ne "") { print ("<a href=\"$CGI_URL/order.cgi?"); print ("storeid=$STOREID"); print ("&function=show\">$CheckoutBtn</a>\n"); } print ("</center>\n"); } if ($CURALIGN eq "center") { print("</center>\n"); } if ($moreinfo_footer eq "checked") { &EmitFile("$DATA_DIR/ufooter.dat"); } print("\n</body>\n</html>"); &EndNewFile } } sub initFormatting { my($MainCurrency, $AlternateCurrency, $locale) = @_; my(@Fields); @Fields = split(/\|/ ,$locale); $decimal = $Fields[2]; $separator = $Fields[3]; @Fields = split(/\|/ ,$MainCurrency); $currency = $Fields[1]; $format1 = $Fields[2]; $format2 = $Fields[3]; @Fields = split(/\|/ ,$AlternateCurrency); $altcurrency = $Fields[1]; $altformat1 = $Fields[2]; $altformat2 = $Fields[3]; if ($currency eq "") {$currency ="\$";} if ($decimal eq "") {$decimal=".";} if ($separator eq "") {$separator=",";} if ($format1 eq "") {$format1="-\$#,###.##";} if ($altcurrency eq "") { $currencyratio = ""; $altformat1 = ""; } if ($altformat1 eq "") {$altformat1 = $format1;} if ($currencyratio eq "") { $altcurrency = ""; $currencyratio = 0.0; } else { $currencyratio *= 1.0; } } sub parseFormatString { my ($formatString) = @_; my ($temp); $currencyplacement = 0; if ($formatString =~ /\#\$\#/) { $currencyplacement = 1; $formatString =~ s/\$/\./; } else { $currencyplacement = 0; } ($temp) = ($formatString =~ /\,(\#+)\.?/); $separatorcount = length($temp); ($temp) = ($formatString =~ /(\.(\#+))/); $precision = 0; if (length($temp) gt 1) { $precision = length($temp) - 1;} } sub pricestring { my($amount) = @_; return &generalpricestring($amount, $currency, $format1, $format2, ""); } sub apricestring { my($amount) = @_; return &generalpricestring($amount, $altcurrency, $altformat1, $altformat2, $currencyratio); } sub generalpricestring { my($amount, $CurrencySymbol, $FormatString1, $FormatString2, $Ratio) = @_; my($Sign); my($FormatString); my($RegexSeparator); if ($CurrencySymbol eq "") { return ""; } if ($CurrencySymbol eq "") { return ""; } if($Ratio eq "") { $Ratio = 1.0; } $amount = sprintf("%f",1.0 * $amount * $Ratio); ($Sign, $Integer, $Fraction) = ($amount =~ /(-*)(\d*)\D?(\d*)/); if ($Sign eq "") { $FormatString = $FormatString1; } else { $FormatString = $FormatString2; } if ($FormatString eq "") { $FormatString = $FormatString1; } &parseFormatString($FormatString); $FormatString2 = sprintf("%%1.%sf", $precision); $amount = sprintf($FormatString2, 1.0 * $amount); ($Sign, $Integer, $Fraction) = ($amount =~ /(-*)(\d*)\D?(\d*)/); $FormatString =~ s/,//g; $FormatString =~ s/\#+/\#/g; # collapse the #'s $FormatString =~ s/(\#[\.\$])\#/$1@/g; # Set the fraction placeholder to @ if ($Sign eq "") { $FormatString =~ s/[()]//g; } $RegexSeparator = $separator; $RegexSeparator =~ s/\./\\\./g; if ($separatorcount > 0 ) { $Integer = reverse($Integer); $Integer =~ s/(\d{$separatorcount,$separatorcount})/$1$separator/g; $Integer = reverse($Integer); $Integer =~ s/^$RegexSeparator//; # Take extra one off the beginning, if it's there } $FormatString =~ s/-/$Sign/; $FormatString =~ s/\./$decimal/; $FormatString =~ s/@/$Fraction/; $FormatString =~ s/\#/$Integer/; $FormatString =~ s/\$/$CurrencySymbol/; return $FormatString; }