$sitename - $title

#!/usr/bin/perl #################################### # gnu-web-tarot # # Michael Tracey # #################################### ## # OK, let's load some modules here. # IF your system doesn't have these, # something is Very wrong. ## use CGI qw(:standard); require "config.pl"; &get_form_data; ## # Global Variables anyone? ## my ($base_url) = 'https://www.sacredsax.com/cgi-bin/tarot'; my ($script_url) = $base_url .'/index.cgi'; my ($zoom_url) = $base_url .'/zoom.pl'; my ($print_url) = $base_url .'/print.pl'; my ($base_path) = '/sacredsax.com/cgi-bin/tarot'; my ($img_url) = "https://sacredsax.com/tarot" . '/tdeck-small'; my ($side_url) = "https://sacredsax.com/tarot" . '/tdeck-small-side'; my ($data_path) = "/home/f14i8aslhgk2/public_html/sacredsax.com/cgi-bin/tarot" . '/cards'; my ($sitename) = "Free Online Celtic Tarot Reading"; my ($bgcolor) = "#000000"; my ($bgimage) = ""; # Leave blank for none. my (@meanings) = ('Question / Situation','Obstacles','Recent Past','Distant Past','Goal','Near Future','You','Influences','Hopes/Fears','Outcome'); ## # OK, lets figure out what they are asking for ## my ($current_card); my (%placements); srand(); &process; exit; sub header { my ($title) = @_; print "Content-type: text/html\n\n"; print "$sitename - $title"; print ""; } sub footer { print ""; print ""; } sub process { my ($x); &header("$sitename - Continuing"); print qq~ ~; my($key); my($card_number); my($chosen_card); my($temp_card); print qq~ ~; for $key (keys %params){ if ($key =~ m/[0-9]\.x/g) { ($chosen_card) = split(/\./, $key); } #print "Card: $chosen_card
\n"; #Debug Printing } print "\n"; $temp_card = int(rand 77); until (&verify_unique("$temp_card")) { $temp_card = int(rand 77); } $params{"$chosen_card"} = $temp_card; print "\n"; for ($x=1;$x <= 10; $x++){ if (!$params{"$x"}) { $params{"$x"} = "back"; } else { print "\n"; } } for ($x=1;$x <= 4; $x++){ print "\n"; if ($x eq 1){ print "\n\n"; } elsif ($x eq 2){ print "\n\n\n\n"; } elsif ($x eq 3){ print "\n\n\n\n"; } elsif ($x eq 4){ print "\n\n\n"; } print "\n"; } print "

"; &instructions; print "

"; &print_card('10'); print "

"; &print_card('5'); print"

"; &print_card('9'); print "

"; &print_card('4'); print "

"; &print_card('1'); print "

"; &print_card('6'); print "

"; &print_card('8'); print "

"; &print_card('3'); print "

"; &print_card('7'); print "

"; print ""; &print_side; &footer; } sub print_card { my ($card_number) = @_; if ($params{"$card_number"} eq "back"){ print ""; } else { print ""; print "

"; } print "
"; print $meanings[($card_number -1)]; if ($card_number eq 1) { print "
Obstacles"; } print ""; } sub print_side { my ($x); print "\n\n"; if ($params{'2'} eq "back") { print "

"; print ""; print "

"; } else { print "

"; print "

"; } print "\n\n"; } sub get_form_data { my ($buffer) = ""; my ($pair); my ($name); my($value); my(@data); my(@a); read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); my (@pairs)=split(/&/,$buffer); foreach $pair (@pairs) { @a = split(/=/,$pair); $name=$a[0]; $value=$a[1]; $value =~ s/\+/ /g; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/~!/ ~!/g; $value =~ s/\cM\n*/\n/g; $value =~ s/\s+/ /g; $value =~ s/[\n\r]/ /sg; #remove \n $value =~ s/\[\]//g; #remove [] $value =~ s/\|//g; #remove | push (@data,$name); push (@data, $value); } %params=@data; %params; return %params; } sub instructions { my ($print_string, $key); for $key (keys %params) { if (($params{"$key"} ne "back") and !($key =~ m/[a-zA-Z]/g)) { $print_string .= "$key=$params{$key}&"; } } $print_string =~ s/&$//; print qq~

~; } sub verify_unique { my($chosen_card) = @_; my($key); foreach $key (keys %params) { if ($params{"$key"} eq $chosen_card) { return 0; } } return 1; }