#!/usr/bin/perl -T -w use strict;
#
# Log order request and redirect to the correct order form, 7/31/01
# This script is confidential and should not be distributed
#
# Removed log information previous to 1/05 on 9/21/05, see CVS history
# Updated 1/11/05 to restore Chess/Checkers BOGO sale
# Updated 2/17/05 to add $10 off bundle sale and add Chess/Checkers to all list
# Updated 4/6/05 to force CD to uppercase and handle CD at end of what
# Updated 4/12/05 to add ginfree sale and to put Gin/500 free at top of all list
# Updated 5/6/05 to fix gift certificate to show before CD
# Updated 5/11/05 to allow Classic to 'Save $5' from About on other Pro games
# Updated 5/30/05 to add freetroopgift_2499 coupon and make sure SKU incl.
# Updated 9/21/05 completely rewritten for readability
# Updated 9/21/05 to use major steps and breakout chunks into subs for readability
# Updated 9/21/05 to add support for new keyword coupons.pl
# Updated 9/21/05 to convert old offers to new ones & handle expired offers
# Updated 9/21/05 Modify ALL and normal URL for offer REQUIRES
# Updated 10/4/05 to keep suboffer from sale or previous offer value
# Updated 10/15/05 to fix refer installer name trimming incl. Free
# Updated 10/28/05 to log orders to MySQL Orders table with extra game info
# Updated 11/2/05 to fix broken Free/Classic upgrade coupons
# Updated 12/30/05 to fix tracker handling from branded installers

# Set default current working directory (needed for mod_perl to find requires)
delete $ENV{PATH};
my $dirScript = "."; # default to current for command-line use
if ($ENV{"SCRIPT_FILENAME"} && $ENV{"SCRIPT_FILENAME"} =~ /^(.+)\/[^\/]+$/ ) {
	$dirScript = $1;
} elsif ($0 =~ /^(.+)\/[^\/]+$/ ) { # if script called with hardpath, find it
	$dirScript = $1;
}

# We can also call and test this script from the command-line
do "$dirScript/mycgilib.pl";  &ReadParse(); # simpler CGI parser creates %in hash
do "$dirScript/coupons.pl"; # offer and sale information now defined here for easier edits
if ($ENV{REMOTE_ADDR}) { $web = 1; }
if (!$web) {
  die "Usage: order.pl <what> <offer> [where]\n" . 
      "Example: order.pl Ws monthlysale_newsletter Ws 12345678\n" .
      "Example: order.pl all penny_homepage\n" unless ($#ARGV >= 0);
  if ($#ARGV >= 0) { $in{'what'} = $ARGV[0]; $in{'from'} = $in{'what'}; }
  if ($#ARGV >= 1) { $in{'offer'} = $ARGV[1]; }
  if ($#ARGV >= 2) { $in{'where'} = $ARGV[2]; }
}
if(!$ENV{HTTP_REFERER}) {$ENV{HTTP_REFERER} = ''}; # prevent warnings if no refer

# STEP 1: SET DEFAULTS FOR ALL FIELDS, NOTHING SHOULD BE BLANK OR INCLUDE HYPHENS
if ((!$in{'what'}) || ($in{'what'} eq "_")) { $in{'what'} = "all"; }
if (($in{'what'} eq "dq") || ($in{'what'} eq "d3"))  { $in{'what'} = "c3";} # old-style bundles
if ((!$in{'where'}) && ($in{'vendor'})) { $in{'where'} = $in{'vendor'}; } # classic vendor
if ((!$in{'how'}) && ($in{'link'})) { $in{'how'} = $in{'link'}; } # dqsoft.com uses link, not how
if ($in{'vers'} && length($in{'vers'}) == 3) { # Convert incorrect short version number 6.2 to 6.02
    $in{'vers'} = substr($in{'vers'}, 0, 2) . "0" . substr($in{'vers'}, 2, 1);
}

# STEP 2: FIGURE OUT WHICH SERVICE TO PROCESS ORDER AND HANDLE SKU MAPPINGS
my %Skus = (); #Skus is defined in global scope
$in{'oldwhat'} = $in{'what'};
my ($strService,$strBaseUrl) = &subDetermineServiceAndSkus();


# STEP 3: IF ORDER REFERRED FROM DIGIBUY ORDER FORM, KEEP EXISTING URL CUSTOM FIELDS
# Used if they click monthly sale, 'show all', or add game from order form
my $flgRedirect = (($ENV{HTTP_REFERER} =~ /digibuy\.com/) && ((!$in{'phone'}) || ($in{'phone'} ne "1")));
if ($flgRedirect) {
    my $strVariation = substr($ENV{HTTP_REFERER}, -2, 2); # last 2 digits should be variation
    if (substr($strVariation, 0, 1) eq "+") { # carryover variation so platform remains on 'View All'
        $in{'variation'} = $strVariation;
    }

    # If best of offer, they have to pick platform, so send to page to pick
    # Also solves problem with getting bundle for only $10 with $30 coupon
    if ((defined($in{'sale'})) && ($in{'sale'} =~ /monthly/)) {
        print "Location: http://dqsoft.com/offer/bestof2006\n\n"; # 
        exit;
    }

    # redirects now process offers and SKUs like anything else, links should have SID/offer, etc. now
}

# STEP 4: IF COOKIE SAVED SID FOR TRACKING, USE IT (unless download tracker above gave it)
if ($ENV{REMOTE_ADDR}) {  # dont look up cookie if called from cmdline
	do '/home/shared/bin/logvisit.pl' unless $INC_logvisit; # for subGetMySID
	$in{'sid'} = &subGetMySID(undef,$in{'cid'});
}

# STEP 5: FIGURE OUT WHAT OFFER TO USE AND APPLY OFFER DETAILS (including old default offers)
$in{'offer'} = &subDetermineOffer();


# STEP 6: LOG THE ORDER REQUEST (SHOULD GOTO ORDERS TABLE IN THE FUTURE)
&subLogOrderRequest;

# STEP 7: BUILD CUSTOM FIELDS FOR EXTRA INFO TO PASSTHRU TO DIGIBUY
if ($strService eq "digibuy") { $strCustomPartialURL = &subBuildCustomFields(); } else { $strCustomPartialURL = ''; }

# STEP 8: BUILD SKU LIST BASED ON WHAT PREFERENCE AND OFFER REQUIREMENTS
if ($strService ne "redir") { $strSKUPartialURL = &subBuildSkuList(); } else { $strSKUPartialURL = ''; }

# STEP 9: BUILD ORDER URL USING BASE, SKU, AND OTHER CALCED FIELDS
if ($strService eq "redir") {  # redirect tells us exactly where to go
    $strUrl = $strBaseUrl;
} elsif (defined($in{'mainoffer'}) && defined($hashOffers{$in{'mainoffer'}}{link}) && (!defined($in{'oldwhat'}) || length($in{'oldwhat'}) == 0 || $in{'oldwhat'} eq 'all')) { # some sales just redirect to page like our 'club' page
    $in{'oldwhat'} = ''if($in{'oldwhat'} eq 'all');
    $strUrl = $hashOffers{$in{'mainoffer'}}{link};
} else { # normal Digibuy order with custom fields and SKUs
	$strBaseUrl          = '' if(!defined($strBaseUrl));
	$strCustomPartialURL = '' if(!defined($strCustomPartialURL));
	$strSKUPartialURL    = '' if(!defined($strSKUPartialURL));
    $strUrl = $strBaseUrl . $strCustomPartialURL . $strSKUPartialURL;
}

# If best of offer, force variation to show special price for Feb 2007 PPC sale
if (defined($in{'offer'}) && ($in{'offer'} =~ /bestof/)) {
  $strUrl =~ s/98946592978\+1//g; # remove any leftover Windows bundle SKU to prevent $10 bundle
  $strUrl =~ s/98946592978\+2/98946592978+4/g;
  $strUrl =~ s/98946592978\+3/98946592978+5/g;
}

# Hide gift if all-stars upgrade
if(defined($in{'offer'}) && ($in{'offer'} =~ /gift/ || $in{'offer'} =~ /freeallstars/)) {
  $strUrl =~ s/(\+116362983182)/$1+1/g;
}


# STEP 10: Redirect them to Digibuy (or other service) to buy
$strUrl =~ s/\!/\_/g; # FAILSAFE: remove ! which causes 'No approved product' errors on DB
if ($in{'test'}) { # allow test param to debug orders without going to DB
    print &PrintHeader; # print HTTP header for output and update cookie
    print "<PRE>Debug output for order.pl\n";
    print "Mainoffer=$in{'mainoffer'}\n";
    print "Service=$strService\n";
    print "BaseURL=$strBaseUrl\n";
    print "CustomPartialURL=$strCustomPartialURL\n";
    print "SKUPartialURL=$strSKUPartialURL\n</PRE>";
    print "Link: <A HREF=\"" . $strUrl . "\">" . $strUrl . "</A>\n";
} else {
    print "Location: $strUrl\n\n"; # redirect if not test
}
exit;


################################ UTILITY ROUTINES ###############################

# STEP 2: FIGURE OUT WHICH SERVICE TO PROCESS ORDER AND HANDLE SKU MAPPINGS
sub subDetermineServiceAndSkus() {
    # List of SKUs on DigiBuy that we currently offer, now single game skus 6/25/03
    $strService = "digibuy"; # assume DigiBuy
    %Skus =   ( 's' => "+92967830239", 'f' => "+93397550471", 'h' => "+93438355552",
                'e' => "+98763240939", 'c' => "+95149469116", 'g' => "+98763592157", 
                'z' => "+102830740950", 'k' => "+98763635178", 'm' => "+98763622711", 
                '3' => "+98946592978", 'r' => "+98763299093", 

                'DECK' => "+98763605589",'BOOK' => "+98763605589",'CD' => "+98946564257+1", # SKUs without platform var
                'GIFT' => "+98763746927+1", 'FREEGAME' => "+98946539142+1",
                'Xx' => "+116362983182");
    
    # See if service should be something other than DigiBuy based on new install tracker
    # SID tracking works well on its own, so we don't try to embed it, just the affiliate 12/30/05
    if ($in{'trk'}) { 
        if ($in{'trk'} =~ m/,/) { $in{'trk'} =~ s/\,.*//g; } # strip blanks after comma
        if ($in{'trk'} =~ m/houseofcards/) {
            $strService = "regnow";      $strAffil = "&affID=houseofcards";
        } elsif ($in{'trk'} =~ m/wugnet/) {
            $strService = "regnow";      $strAffil = "&affID=wugnet";
        }
        $in{'inst'} = ""; # ignore any installer naming, tracker gets priortiy 12/30/05
        $in{'where'} = $in{'trk'};
    }

    # strip before - for branded installers that give the full installer name
    # e.g. Install-Spades-Cnet.exe, where should equal 'cnet'
    if ($in{'inst'}) { $in{'where'} = $in{'inst'}; } # renamed installer showing d/l site gets priority
	if (!defined($in{'where'})) {$in{'where'} = '';}
    $in{'where'} =~ s/\[\d\]//i;       # remove [1] [2] etc for duplicated download installers
    $in{'where'} =~ s/\-free//i;       # remove free in name
    $in{'where'} =~ s/\-patch//i;      # remove patch in name
    $in{'where'} =~ s/\_patch//i;    # remove patch in name
    $in{'where'} =~ s/install\-//i;    # remove install prefix w/hyphen
    $in{'where'} =~ s/install//i;      # remove install prefix w/o hyphen
    $in{'where'} =~ s/\.exe//i;        # remove .exe suffix if there (it shouldnt be)
    foreach $sku (keys %Skus) { # now scans ALL games since from isnt always set
        my $strGame = $hashGameMappings{$sku} = $hashGameMappings{$sku}; # avoid warning
		$strGame = '' if(!defined($strGame)); # avoid warning
        if ($in{'where'}) {
            if ($in{'where'} eq $strGame) { $in{'where'} = ""; } # ignore if its just game name
            if ($in{'where'} eq "d_" . $strGame) { $in{'where'} = ""; } # lots of d_game names?
            if ($in{'where'} eq $strGame . "32") { $in{'where'} = ""; } # remove old 32 name from patch
			$in{'where'} =~ s/$strGame\-//i; #remove the game name if still there
			$in{'where'} =~ s/$strGame//i;
        }
    }
    if ($in{'where'}) {
        if (lc $in{'where'} eq "1") { $in{'where'} = ""; } # ignore if its just "1" or "2"
        if (lc $in{'where'} eq "2") { $in{'where'} = ""; }
        if (lc $in{'where'} eq "free") { $in{'where'} = ""; } # ignore if its just free
        if (lc $in{'where'} eq "pro") { $in{'where'} = ""; } # ignore if its just pro
        if ($in{'where'} =~ m/tmp$/) { $in{'where'} = ""; } # ignore if ends in tmp filename
    }

    # Digibuy order by phone always overrides affiliate
    if ($in{'phone'}) { $in{'where'} = "DigiBuyPhone"; } 
    
    # See if eSellerate affiliate ID provided and, if so, use them to process order
    # Game sends this if they click to buy from a registry-branded install 
    if ($in{'redir'}) { $strService = "redir"; }
    
    # For other services, we override our SKUs and base URL (for affiliates)
    if ($strService eq "regnow") {
        %Skus =   ( 'h' => "2746-2", 's' => "2746-3", 'e' => "2746-4", 'f' => "2746-5", 
                    'c' => "2746-6", 'g' => "2746-21" );
    } elsif ($strService eq "esellerate") { # prob irrelevant since now uses redir
        %Skus =   ( 'g' => "SKU6023477106", 'h' => "SKU4409844318", 
                    's' => "SKU5485222759" );
    }

    # redirect them to base DigiBuy order form with tracking code (unless test=1)
    if ($in{'newtest'}) {
        $strBaseUrl = "http://dqsoft.com/digibuy/order_";
    } elsif ($strService eq "regnow") {
        $strBaseUrl = "http://www.regnow.com/softsell/nph-softsell.cgi?nada=y$strAffil&items=";
    } elsif ($strService eq "esellerate") { # now mostly uses redirs but left
        $strBaseUrl = "http://store.eSellerate.net/s.asp?s=STR6935297919$strAffil&Cmd=BUY&SkuIDC=";
    } elsif ($strService eq "redir") {
        $in{'redir'} =~ s/\%3F/\?/g; # replace CGI ? back for redirects esp regnow affils
        $strBaseUrl = $in{'redir'};
    } else {
        $strBaseUrl = "http://www.digibuy.com/cgi-bin/order.html?";
    }

    return ($strService,$strBaseUrl);
} #STEP 2 :subDetermineServiceAndSkus


# STEP 5: FIGURE OUT WHAT OFFER TO USE AND APPLY OFFER DETAILS (including old default offers)
sub subDetermineOffer() {
    # Strip off .html (any extension), or trailing slash off offername redirects
    if ($in{'offer'}) { 
        #debug: print "Offer $in{'offer'} found...\n";
        $in{'offer'} =~ s/\..*//g; $in{'offer'} =~ s/\/.*//g;

        # Handle bad customerids for refer offer by mapping to CID 0
        if (($in{'offer'} eq "refer_c") || ($in{'offer'} eq "refer_c[CUSTOMERID]")) {
            $in{'offer'} = "refer_c0";
        }
    }

    # Auto-set current offer/coupon to use if monthly sale requested
    if (($in{'sale'}) && ($in{'sale'} =~ "monthly") || # allow sale= to override offer
        ($in{'offer'}) && ($in{'offer'} =~ "monthly")) { # new offer syntax
        if (($in{'offer'}) && ($in{'offer'} !~ "monthly")) { # switched offers
            $in{'oldoffer'} = $in{'offer'}; # save old offer to report later
        }

        # get suboffer from either sale or previous offer value (if given, keep it!)
        if (($in{'sale'}) && ($in{'sale'} =~ "monthly")) {
            ($in{'mainoffer'},$in{'suboffer'}) = split /\_/, $in{'sale'};
            if ($in{'suboffer'}) { 
                $in{'offer'} = &subGetMonthlyOffer() . "_" . $in{'suboffer'}; 
            } else {
                $in{'offer'} = &subGetMonthlyOffer(); # no suboffer given
            }
        }
        if ($in{'oldoffer'}) { # original suboffer (if given) always overrides sale suboffer
            ($in{'mainoffer'},$in{'suboffer'}) = split /\_/, $in{'oldoffer'}; 
            if ($in{'suboffer'}) { 
                $in{'offer'} = &subGetMonthlyOffer() . "_" . $in{'suboffer'};
            }
        }
    }

    # If no offer given, try to map old specials/how to new offers
	$in{'what'} = '' if(!defined($in{'what'}));
    if ($in{'from'}) { $in{'from'} = lc $in{'from'}; } # make sure Free is lower-case for checks
    if ((!$in{'offer'}) || (substr($in{'offer'}, 0, 4) eq "web_")) { # web links arent real offers
        if (($in{'reg'}) && ($in{'what'} eq "a3")) { # add-on order from in-game in 6.04 or older
            $in{'what'} = "all";  
            $in{'offer'} = "addon_old"; # old in-game add-licenses which used 'a3' 8/6/03
        }
        elsif (($in{'what'} =~ m/[fmcp]3/i) && ($in{'how'} eq "up")) { 
            $in{'offer'} = "addon_old";   # bundleup $10 discount for customers
        }  
        elsif ((($in{'from'}) && (substr($in{'from'}, 0, 1) eq "f")) || (lc substr($in{'what'}, 0, 1) eq "f")) { 
            $in{'offer'}= "freeup_old";   # 100% free upgrades from previous to 6.30
            substr($in{'what'}, 0, 1) = "W"; # convert possible Free in what to Windows
        }
        elsif ((($in{'from'}) && (substr($in{'from'}, 0, 1) eq "r")) || (lc substr($in{'what'}, 0, 1) eq "r")) { 
            $in{'what'} = "all"; # force them to Windows (for old a3/r3 whats)
            $in{'offer'}= "classicup_old";   # Classic upgrades from previous to 6.30
        }
        elsif (($in{'how'}) && ($in{'how'} eq "add")) { 
            $in{'offer'} = "addon_old"; # no offer code, but how=add
        }
        elsif ($in{'special'}) { 
            $in{'offer'} = "special_".$in{'special'}; # convert old special= syntax
        }
    } #no offer
    
    # If offer has expired, clear the offer
    if ($in{'offer'}) {
        # change Windows and Mac expired offers from game so they actually get 15% off
        if ($in{'offer'} =~ m/trial_Gexpired/) {
            $in{'offer'} = "expired_trial";
        }

        #debug: print "Offer $in{'offer'} found...\n";
        ($in{'mainoffer'},$in{'suboffer'}) = split /\_/, $in{'offer'}; # split off suboffer
        if (!$in{'suboffer'}) { $in{'suboffer'} = ""; } # prevent warnings if no suboffer
        $strExpires = $hashOffers{$in{'mainoffer'}}{expires};
        if (($strExpires) && ($web)) { # to test in DOS (ignores expires), comment the following line
            use Date::Parse; # if you put require here to work on DOS, it breaks on server...
            if (str2time($strExpires) < time) { # expired, clear offer/coupon
                $in{'offer'} = $in{'mainoffer'} = $in{'suboffer'} = "";
            }
        }
    }#offer

    # If we have an offer, lookup the parameters of it
    if ($in{'mainoffer'}) {
        #debug: print "Looking up parameter of main offer: $in{'mainoffer'}...\n";

        # Offer will determine what DigiBuy coupon code to use
        $in{'coupon'} = $hashOffers{$in{'mainoffer'}}{coupon}; # override any coupon in URL

        # Default what games show to those given in the offer
        if ($in{'what'} eq "all") { 
            $in{'what'} = $hashOffers{$in{'mainoffer'}}{what}; 
        } elsif (length($hashOffers{$in{'mainoffer'}}{what}) == 1) { # add off what to order what if not there
            if ($hashOffers{$in{'mainoffer'}}{what} !~ m/$in{'what'}/ ) {
                $in{'what'} .= $hashOffers{$in{'mainoffer'}}{what}; 
            }
        } elsif($in{'what'} !~ /$hashOffers{$in{'mainoffer'}}{what}/) {
            $in{'what'} .= $hashOffers{$in{'mainoffer'}}{what};
        }

        # Offer requires will be handled later when it builds the SKU list
        $in{'requires'} = $hashOffers{$in{'mainoffer'}}{requires};

        # Debug offers by uncommenting this line
        #debug: print "Ordering $in{'what'} using offer $in{'mainoffer'} suboffer $in{'suboffer'}" . " with coupon $in{'coupon'} requiring $in{'requires'}\n";

    # If no offer used, but coupon provided, set a pretend offer for coupon
    } elsif ($in{'coupon'}) { # no offer, but coupon given
        $in{'offer'} = "coupon_" . $in{'coupon'};
    }

    # no coupons allowed for just a single CD order
    if (defined($in{'what'}) && $in{'what'} eq "CD") { $in{'coupon'} = ""; } 

    return $in{'offer'};
}


# STEP 6: LOG THE ORDER REQUEST (NOW INTO MYSQL ORDERS TABLE)
sub subLogOrderRequest() {
    if ($ENV{REMOTE_ADDR}) { # dont log if called from cmdline
        do '/home/shared/bin/logvisit.pl' unless $INC_logvisit; # for subGetMySID

        my $strRefer = $ENV{HTTP_REFERER};
        if ($strRefer) { $strRefer =~ s/%(..)/pack("C",hex($1))/ge; } # unescape/convert %2C, etc MIME characters
        if (!$strRefer) { $strRefer = ""; } # guarantee non-null value
        &subRecordVisit($strRefer,"http://" . $ENV{'SERVER_NAME'} . $ENV{'REQUEST_URI'}); # log visit to get refer in case initial visit

        my $strSID = &subGetMySID(); # get their SID from cookie, etc.
        if (!$strSID) { $strSID = ""; } # guarantee non-null value
        if (!$in{'what'}) { $in{'what'} = ""; } # guarantee non-null value
        if (!$in{'offer'}) { $in{'offer'} = ""; } # guarantee non-null value
        if (!$strService) { $strService = ""; } # guarantee non-null value
        if (!$in{'where'}) { $in{'where'} = ""; } # guarantee non-null value

        # ok for version, days, and games to be null if not called from game
        require DBI;
        $dbh = DBI->connect("DBI:mysql:database=dqsoft;host=localhost",'perlexec');
        # dont bother logging errors: or output("Could not connect to database");
        # $dbh->{'ShowErrorStatement'} = 1;
        my $query = "INSERT INTO Orders (sid,id_customer,url_refer,what,offer,regservice,installer,game_version,game_days,game_count,timestamp) VALUES (?,?,?,?,?,?,?,?,?,?,NOW())";
        my $sth = $dbh->prepare($query);
        $sth->execute($strSID,$in{'cid'},$strRefer,$in{'what'},$in{'offer'},$strService,$in{'where'},$in{'vers'},$in{'days'},$in{'games'});
    }
}


# STEP 7: BUILD CUSTOM FIELDS FOR EXTRA INFO TO PASSTHRU TO DIGIBUY
sub subBuildCustomFields($) {
    my $strPartialURL = "";
	my ($strCID, $strSID, $strOffer, $strWhere) = ();
	my $strEncodeThese = "!\@#\$\%^&*()=+[{]}\|;:'\",<.>/?"; #list all characters we want to use that Digibuy won't let us use directly in Urls.
	my $regExp = $strEncodeThese;
	$regExp =~ s/(.)/\\$1|/g;
	$regExp =~ s/\|$//g;	
	if($in{'cid'})   { $strCID   = $in{'cid'};   $strCID   =~ s/($regExp)/'_-'.sprintf("%lX",unpack("C",$1))/ge; } #encode characters Digibuy rejects as _-Hex values.
	if($in{'sid'})   { $strSID   = $in{'sid'};   $strSID   =~ s/($regExp)/'_-'.sprintf("%lX",unpack("C",$1))/ge; } # we encode this way because the % is also a character
	if($in{'offer'}) { $strOffer = $in{'offer'}; $strOffer =~ s/($regExp)/'_-'.sprintf("%lX",unpack("C",$1))/ge; } # that Digibuy won't let us use in Urls.
	if($in{'where'}) { $strWhere = $in{'where'}; $strWhere =~ s/($regExp)/'_-'.sprintf("%lX",unpack("C",$1))/ge; }
	
    # DIGIBUY 'View All', 'Add', and 'Sale' graphic now include this info in URL so we can re-process

    # CUSTOM 1: Pass CustomerID through, if provided by game (to prevent creation of new CID)
    if ($in{'cid'}) { $strPartialURL .= "+a1." . $strCID; }
    # TODO: Also need to log to Sessions table to map SID to CID

    # CUSTOM 5: Pass SID through (split from tracker before)
    if ($in{'sid'}) { $strPartialURL .= "+a5." . $strSID; }

    # CUSTOM 7: Pass Offer/Suboffer through
    if ($in{'offer'}) { $strPartialURL .= "+a7." . $strOffer; }

    # CUSTOM 8: Pass Where/affiliate through (split from tracker before)
    if ($strWhere) { $strPartialURL .= "+a8." . $strWhere; }

    # If coupon used, include it, otherwise tell Digibuy to clear any leftover coupon value
    if ($in{'coupon'}) { 
        $strPartialURL .= "+c." . $in{'coupon'};
    } else {
        $strPartialURL .= "+c.empty";
    }
	
    return substr($strPartialURL, 1) . "+139528"; # strip leading + and add authorId
} #subBuildCustomFields

# STEP 8: BUILD SKU LIST BASED ON WHAT PREFERENCE AND OFFER REQUIREMENTS
# Create 'ALL' URL for show all including all known SKUs
sub subBuildSkuList() {
    my $strPartialURL = "";

    # STEP 8a: Figure out what platform and game are from WHAT
    if (defined($in{'what'}) && $in{'what'} eq "all") {
        $strPlat = "all";  $strGame = "all";  $strWhatPattern = "."; # show all SKUs
        undef $Skus{'3'};  # dont show CD or bundle SKU in all list
        # undef $Skus{'CD'}; # need to show CD now for free CD sale (REMOVE LATER!) 
    } else {
        $strPlat = uc subParsePlatformFromWhat($in{'what'}); # platforms always upcase
        $strGame = subParseGameFromWhat($in{'what'}); # games lowercase, but GIFT and DECK arent
        $strWhatPattern = $strGame;
    }
    $strGame =~ s/gift/GIFT/; $strGame =~ s/book/BOOK/; $strGame =~ s/deck/DECK/; $strGame =~ s/cd$/CD/; # reupcase non-games
    #debug: print "Platform = $strPlat, Game = $strGame\n";

    # STEP 8b: Determine the variation for the specific device
    if ($in{'variation'}) { # if variation given from redirected order form, keep the same
        $strVariation = $in{'variation'};
    } elsif ($strPlat eq "PP") {
        $strVariation = "+4"; # PocketPC
    } elsif (($strPlat eq "N") || ($strPlat eq "6") || ($strPlat eq "S")) {
        $strVariation = "+5"; # Symbian
    } elsif (($strPlat eq "P") || ($strPlat eq "5")) {
        $strVariation = "+3"; # PalmOS
    } elsif ($strPlat eq "A") {
        $strVariation = "+2"; # Apple Mac
    } elsif (($strPlat eq "W") || ($strPlat eq "F")) { 
        $strVariation = "+1"; # PC-Windows
    } else {
        $strVariation = ""; # no platform given, let them pick
    }
    #debug: foreach $sku (keys %Skus) { print "$sku=>$Skus{$sku}\n"; };

    # Unless what specifically includes 3 for bundle, always hide it since we upsell
    if (!defined($in{'what'}) || $in{'what'} !~ m/3/) { undef $Skus{'3'}; }

    # Mahjongg only exists on Windows (or all) platform
    if (($strVariation) && ($strVariation ne "+1")) { undef $Skus{'m'}; }

    # STEP 8c: Add any required SKUs for offer and remove from future wildcard match
    # Removed ($ENV{HTTP_REFERER} =~ m/fivehfree/) check, coupon should still be set...
    if ($in{'requires'}) {
        if (($in{'requires'} ne "CD") && ($in{'requires'} ne "GIFT")) { 
            $in{'requires'} = substr($in{'requires'}, 0, 1); # we only handle 1 req'd right now
        }
        $strPartialUrl .= $Skus{$in{'requires'}};
        if (($in{'requires'} ne "CD") && ($in{'requires'} ne "GIFT")) { 
            if ($strService eq "digibuy") { $strPartialUrl .= $strVariation; }
        }
        #debug: print "Enforcing required $in{'requires'} by adding $Skus{$in{'requires'}}\n";
        undef $Skus{$in{'requires'}}; # remove from SKU list so doesnt get added again
    }

    # Freegame SKU can only be included via coupon requires, not via all or what
    if ($Skus{'FREEGAME'}) { undef $Skus{'FREEGAME'}; }

    # STEP 8d: Handle CD, GIFT, DECK, and other non-game SKUs only
    foreach $strSku (sort keys %Skus) {
        if ($Skus{$strSku}) {
            #debug: print "Scanning SKU '$strSku' " . $Skus{$strSku} . "\n";
            if (length($strSku) >= 2) { # only match non-games
                if (defined($in{'what'}) && (($in{'what'} eq "all") || ($in{'what'} =~ m/$strSku/))) {
                    $strPartialUrl .= $Skus{$strSku};  # no variation
                    $strGame =~ s/$strSku//; # dont match again on games
                } #substr
            } #length
        } #strNonGameSKU
    } #foreach
    #debug: foreach $sku (keys %Skus) { print "$sku=>$Skus{$sku}\n"; };
    #if ($in{'what'} eq "CD") { undef $Skus{'c'}; } # dont match Cribbage on CD request

    # STEP 8e: Scan through all other game SKUs 
    foreach $strProd (sort keys %Skus) {  # show all products that match from our hash list
        if (($Skus{$strProd}) && (length($strProd) == 1)) { # only match games
            #debug: print "Scanning SKU '$strProd' " . $Skus{$strProd} . "\n";
            if ((defined($in{'what'}) && $in{'what'} eq "all") || ($strGame eq "all") || (index($strGame, $strProd) >= 0)) { # search whole string for bundles
                $strPartialUrl .= $Skus{$strProd};  # add SKU to URL
                if ($strService eq "digibuy") { $strPartialUrl .= $strVariation; }
            } #index
        } #strProd
    } #foreach

    return $strPartialUrl;
} #subBuildSkuList