<![CDATA[
#!/usr/bin/perl
use strict;
#use CGI qw(:standard);
#you may want to uncomment line above for CGI use
#I am not a Perl expert, and you will notice it.
#I am much more talented on the client side.
#In any case this script, which is perfectly working on whatever server
#with a Perl interpreter installed, is an example of how fairly simple this type of scripts
#can be.
#the idea is:
#Limit an offer to a certain amount of time, and when the offer is on, say it on your commercial.
#if the user after viewed the commercial clicks your page
#you verify if the referrer is the page where the ad is
#if so, you run a random selection within a limit set by you: say 1 chance out of 100
#if the user gets the luck number, say 30, he gets the offer
#he must then write down the subsequent alpha-numeric number provided
#when at your shop will provide it
#you veirfy it is inside the list of valid generated numbers (only shop managers must access to the file which stores them)
#if it is you instruct another small script to delete the entry, and you give the free product
#even better: a discounted product.
#Listen, there is a workaround:
#an user might view your commercial 100 times to collect numbers and deal them to friends
#but if he/she does so and watches your ad one hundred times just for this...
#hey man, you can give a free product, or better a discounted one, for a limited time
#since if somebody is doing such a thing, it means you shop is WANTED!!
# I RECCOMEND YOU TO TEST THIS SCRIPT A FEW TIMES BEFORE USING for a web page
#STAGES:
#0: generate a Chance random number, if matches with the lucky number, you proceed to assign a number to the surfer.
#if not prompt the surfer he's been unlucky and exit. To try again he'd see the ad again. In fact...
#... this script doesn't run if the visit does not come from a list fo valid referrers (the pages where you've a running ad).
#1: generate random number if (step 0 is) succesful.
#2: compare with already generated
#3: if already generated restart from beginning (step 1).
#4: if not proceed to store it in the section of the already generated ones
#the access to this data must be granted only to the manager of the shop
#5: print the number for the user
#6: provide the shop with a script that deletes numbers from the generated list once provided at desk.
#7: provide the shop with a script that deletes all entries upon manager's request (when the offer is over).
##################### CUSTOM SECTION #####################
my $chanceAmount=1; #the higher, the less the chances. You can custom accordingly.
#do NOT delete the semicolumn ( ; )
#it yields a number of chances equals to this number plus 1.
#So if = 9, chances are 1 out of 10. If 99 are 1 out of 100. If 1 chances are... 1 out of 2 !
my $luckyNumber=1; #custom within limits of variable above. Same warning as above.
my $file='keys.txt'; #custom with name and path to your log file of generated numbers.
#Do NOT delete or change the SINGLE APEX quotes or the semicolumn ( ; ) !!
my $email='myEmail@myShop.bet'; #custom.
#Do NOT delete SINGLE APEX quotes or the semicolumn ( ; ), do not change them with double apex ones!
my @referrers=( #you can custom provided you do not delete SINGLE APEXES or commas: each entry a page where your ad is
#separate each entry with a comma, EXCEPT LAST ONE, and include between SINGLE quote marks: instance:
# 'http://www.newUrl.com', SINGLE APEX, Url, SINGLE APEX, COMMA
# 'http://www.newUrl2.com', SINGLE APEX, Url, SINGLE APEX, COMMA (...)
# 'http://www.newUrl3.com',
# 'http://www.lastUrl.com' LAST ENTRY: NO COMMA HERE!
'http://www.somesite.cip\norty\index.html',
'http://www.somesite.ciop\shoes\greenOnes.html'
);
my $expiringOfferDate="June 21, 2001"; #custom, do not delete the semicolumn ( ; )
##################### custom section OVER #####################
#do not edit below unless sure what you're doing.
sub errors(){#a quite simple, even dumb, example of error handling subroutine for .cgi files
print "Content-type: text/html\n";
print "<body>An error occurred while processing your data: <strong>Database File not found</strong>. We have been unable to provide your number. Please inform the system Administrators of this error at: <a href='mailto:$email'>$email</a></body>";
};
my $rec=0;
sub recursiveError(){
print "Content-type: text/html\n";
print "<body>An error occurred while processing your data: <strong>Excessive recursion, impossible to generate an appropiate random number after $rec attempts with randomizer() subroutine</strong>. We have been unable to provide your number. Try once again or please inform the system Administrators of this error at: <a href='mailto:$email'>$email</a></body>";
return 0;};
sub badLuck(){
print "Content-type: text/html\n";
print "<body>You've been unlucky, try again the next time you see our ad!</body>";
return 2;}; #return 2 just flags a successful performance of the randomizer() routine, which yields an unlucky number
#if luck returns 1, if errors returns 0. In case you might need to collect log data.
#such a thing might be achieved through sorta:
# if(randomizer()){...go print on log file 1...}else{...go print on log file 2...}
my $thisReferrer=0;
my $SSL=($ENV{'DOCUMENT_URI'})?$ENV{'DOCUMENT_URI'}:$ENV{'HTTP_REFERER'};
#above: once I read on a Perl group that HTTP_REFERER returns nothing on secured sockets... uhm....
if($SSL){
for (my $r=0;$r<=$#referrers ;$r++) {#following runs only on a CGI application given the %ENV hash.
if($referrers[$r] eq $SSL){$thisReferrer=$referrers[$r];last;}
}
};
sub invalidReferrer(){
print "Content-type: text/html\n";
print "<body>An error occurred while processing your data: <strong>Invalid Referrer Url</strong>. We have been unable to provide your number. Please inform the system Administrators of this error at: <a href='mailto:$email'>$email</a></body>";
return 0;};
$luckyNumber=($luckyNumber>$chanceAmount)?$chanceAmount:$luckyNumber; #to be safe...
##################### STAGE 0 #####################
my $conditions=0;
my $combination="";
srand;
#remember: rand in Perl uses the argument as a limit not to include: if rand 10, max is... 9!
my $try=int(rand ($chanceAmount+1));#good luck or bad luck?
if($try==$luckyNumber){$conditions=1;};
sub randomizer(){#create original random number
#if(!$thisReferrer){return invalidReferrer();};#the user connected by sth else, not form your ad, no idea what...
$rec++;if($rec==1000){return recursiveError();};#not elegant but gives an idea on how to exit a long recursion,
#unlikely anyway: combinations are many, and of variable length
#and the database must be cleaned up of one entry each time a number gets used.
if($conditions){
##################### STAGE 1 #####################
my @letters=("A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T","U","V","W","X","Y","Z");#only uppercase, you'd counfound L with 1: l1
my $limit=int(rand 7)+4;#at least 4 digits, at most 10
for (my $i=0;$i<$limit ;$i++) {
my $alternateNumLet=int(rand 2);#so if 0, add a number, if 1 add a letter
my $aLetter=uc($letters[int(rand ($#letters+1))]);#gets a random letter from letters array
$aLetter=($aLetter eq "I")?"i":$aLetter;# I can be confused with 1: I1, so better i1
$combination.=($alternateNumLet)?$aLetter:int(rand 9)+1;#excludes zero, so O=letter, max num 9 (one digit...)
#to fetch zero too, just drop +1, raise 9 to 10 too please.
};#I believe the section above might be used also by a better Perl scripter than me.
##################### STAGE 2 #####################
open(FILE, $file) or die errors();
while (<FILE>) {
chomp($_);
##################### STAGE 3 #####################
if($_ eq $combination){close(FILE);return randomizer();};
};
##################### STAGE 4 #####################
close(FILE);
open(FILE, ">>$file") or die errors();
print(FILE "$combination\n");
close(FILE);
$conditions=0;
$thisReferrer=0;
##################### STAGE 5 #####################
print "Content-type: text/html\n";
print "Congratulations: your lucky number is:<h2 align='center'>$combination</h2>\nYou can use it within $expiringOfferDate.";
return 1;}#you have number
else{$thisReferrer=0;return badLuck();};
};
randomizer();
]]>