#!/usr/bin/perl my $cgi_title = "Slayers Character Matchmaker"; my $cgi_url = "index.cgi"; $| = 1; ## Set autoflush to yes use strict; print < $cgi_title EOF my(%CONFIG,%CONFIG_INIT,%FORM,$Error_Message); &parse_form(); my $debug = 0; ## Weight of '0' means that this trait is /excluded/ from sum totals ## and thus a special trait! my %weight = ( charisma => 2.5, curiosity => 2.5, id => 1.5, intelligence => 2.5, will => 2.5, zsmartass => 0 ); my @question_db = ( { question => "If a friend asked me to make something for them, and I agreed to do so, I would probably...", answers => [ { answer => "stop at nothing until I finished it", will => 2 }, { answer => "work on it whenever I have the time", will => 1 }, { answer => "pick at it here and there", will => 0 }, { answer => "forget about it until they ask me again", will => -2, charisma => -1 } ] }, { question => "When meeting someone new, the first thing I do is...", answers => [ { answer => "eagerly shake their hand and try to find a common bond", charisma => 1 }, { answer => "ask if they want to go out for dinner", charisma => 2 }, { answer => "grin and smile", charisma => 0 }, { answer => "nod my head and go on about my business", charisma => -2 } ] }, { question => "When I see a spider on the floor...", answers => [ { answer => "Eek! I run to get someone else to take care of it! ", id => 1 }, { answer => "I leave it alone. It's not bothering me.", id => 0 }, { answer => "I calmly scoop it up with a napkin and take it outside.", id => -2 }, { answer => "KILL! KILL! ... I mean, I stomp on it.", id => 2, zsmartass => 1} ] }, { question => "If there are two routes to my destination, with one being safe and straightforward, the other unfamiliar and twisty, the road I'd take...", answers => [ { answer => "would be the twisty road! I live for the unknown", curiosity => 2}, { answer => "would be the straightforward one", curiosity => -1, will => 1}, { answer => "depends on whether I'm in a hurry or not", curiosity => 0}, { answer => "depends on the toss of a coin", curiosity => 1} ] }, { question => "You're in a desert, walking along when you look down and you see a tortoise on its back, its belly baking in the hot sun, beating its legs trying to turn itself over but it can't. What do you do?", answers => [ { answer => "Flip the turtle over so it can walk.", id => -2}, { answer => "Watch it suffer, and maybe even kick sand in its eye.", id => 2}, { answer => "The turtle got himself there, he can get himself out.", id => 1}, { answer => "What desert? What's a tortoise?", id => 0, zsmartass => 1} ] }, { question => "My favorite card game would be...", answers => [ { answer => "poker / stud", intelligence => 2 }, { answer => "blackjack", intelligence => 1 }, { answer => "uno / crazy eights", intelligence => 0 }, { answer => "go fish", intelligence => -1 } ] }, { question => "If I were to be seen in a nightclub, I would be...", answers => [ { answer => "cutting a jig in the middle of the dance floor", charisma => 1 }, { answer => "getting hookups for potential dates by the bar", charisma => 2 }, { answer => "minding my own business, or maybe playing pool", charisma => 0 }, { answer => "leaving", charisma => -2 } ] }, { question => "When it comes to food, I like to...", answers => [ { answer => "try new things", curiosity => 2, will => 1}, { answer => "eat at the most expensive and exclusive restaurants", curiosity => 1, will => 0}, { answer => "cook for myself", curiosity => 0, will => 1}, { answer => "eat whatever's handy", curiosity => -2, will => 0} ] }, { question => "Most mornings, I get out of bed...", answers => [ { answer => "on the alarm clock's first alarm", will => 1 }, { answer => "on the alarm clock's second alarm", will => 0 }, { answer => "automatically, at the same time every day", will => 2 }, { answer => "but then I fall right back to sleep.", will => -1 } ] }, { question => "My favorite movie is most like...", answers => [ { answer => "Mr. Holland's Opus or The Sixth Sense", id => -2, intelligence => 2 }, { answer => "Titanic or Last of the Mohicans", id => -1, intelligence => 1 }, { answer => "Die Hard or Conan the Barbarian", id => 2, intelligence => 0 }, { answer => "Dumb and Dumber or Friday", id => 1, intelligence => 0 } ] }, { question => "When met with an obstacle, my tactics are best described as...", answers => [ { answer => "\"Guile and trickery will win the day!\"", intelligence => 1, id => 1, charisma => 1 }, { answer => "\"Planning and forethought are key.\"", intelligence => 2, id => -2 }, { answer => "\"Tactics? I don't need no stinkin' tactics! Cry havoc, and let loose the hounds of war!\"", intelligence => 0, id => 2}, { answer => "\"I let other people do the thinking; it's not my specialty.\"", intelligence => -2, id => 2} ] }, { question => "If a gameshow host offered the choice of either (a) \$1000, or (b) a coin toss to determine whether I get either \$2000 or \$0, I would...", answers => [ { answer => "take the \$1000 and walk", curiosity => 0 }, { answer => "take the chance for more money, even though I could lose it all", curiosity => 2 }, { answer => "mug the guy, grab the \$2000, and run like hell", curiosity => -1, id => 2, zsmartass => 1 }, { answer => "ask the studio audience for help", curiosity => 1, will => -1 } ] }, { question => "The \"right\" way to woo a romantic interest is to...", answers => [ { answer => "invite them out to a candlelight dinner by the seashore", charisma => 3 }, { answer => "find out what they like and give them a present", charisma => 2, intelligence => 1 }, { answer => "play hard-to-get and shun them at every opportunity", charisma => -1 }, { answer => "club 'em over the head and drag 'em home", charisma => -2, id => 1, zsmartass => 1 }, ] }, { question => "When faced with almost-certain death, I tend to...", answers => [ { answer => "wisecrack, buying myself time to implement my cunning plan", will => 1, charisma => 1, intelligence => 1}, { answer => "flee, with tail between legs", will => -2, id => 1 }, { answer => "try my darnedest to work with that 'almost' part", will => 2, intelligence => 1 }, { answer => "close my eyes and hope for the best", will => 0, id => 1 } ] }, { question => "As for what I want from life, I did it all for the...", answers => [ { answer => "nookie", id => 2}, { answer => "Benjamins", id => -1}, { answer => "food", id => 2}, { answer => "friends", id => -2} ] } ) ; my %character_db = ( amelia => { fullname => 'Amelia wil tesla Saillune', filename => 'amelia.jpg', charisma => 4, curiosity => 6, id => -3, intelligence => 3, will => 7 }, gourry => { fullname => 'Gourry Gabriev', filename => 'gourry.jpg', charisma => 4, curiosity => 5, id => 5, intelligence => -1, will => 2 }, filia => { fullname => 'Filia ul Copt', filename => 'filia.jpg', charisma => -2, curiosity => 0, id => -1, intelligence => 5, will => 5 }, lina => { fullname => 'Lina Inverse', filename => 'lina.jpg', charisma => 3, curiosity => 2, id => 10, intelligence => 4, will => 3 }, martina => { fullname => 'Martina Xoana mel Navratilova', filename => 'martina.jpg', charisma => 1, curiosity => 1, id => 12, intelligence => -3, will => -3 }, naga => { fullname => 'Naga the White Serpent', filename => 'naga.jpg', charisma => 1, curiosity => 2, id => 8, intelligence => 0, will => -5 }, sylphiel => { fullname => 'Sylphiel Nels Rada', filename => 'sylphiel.jpg', charisma => 3, curiosity => 0, id => -5, intelligence => 4, will => 4 }, valgarv => { fullname => 'Valgarv', filename => 'valgarv.jpg', charisma => -7, curiosity => -4, id => 13, intelligence => 2, will => 1 }, xelloss => { fullname => 'Xelloss', filename => 'xelloss.jpg', charisma => 8, curiosity => -2, id => -1, intelligence => 7, will => 3 }, zangulus => { fullname => 'Zangulus', filename => 'zangulus.jpg', charisma => 4, curiosity => 1, id => 0, intelligence => 0, will => 5 }, zelgadiss => { fullname => 'Zelgadiss Graywords', filename => 'zelgadiss.jpg', charisma => -5, curiosity => -3, id => -3, intelligence => 7, will => 3 } ) ; my %myscore = () ; ## Personal scores in each category my %diffs = () ; ## Person vs Match cumulative scores my ($min, $minchar) = (32768,0); my $q_bgcolor = 'BGCOLOR="#400040"'; my $completed_form = 0; my $completed_items = 0; my $number_of_questions = $#question_db + 1; # $FORM{a1} = '1'; print "Answer 2/2 is $question_db[1]{answers}[1]->{answer}
\n" if ($debug >= 3) ; if (%FORM) { ## If there's stuff for the form to "grade" foreach my $formkey (sort keys %FORM) { ## For each item, add the points for the answer's categories to %myscore if ( (lc(substr($formkey,0,1)) eq 'q') && (lc(substr($FORM{$formkey},0,1)) eq 'a')) { print "OK: $formkey = $FORM{$formkey}
\n" if ($debug >= 3); my ($qno,$ano) = (substr($formkey,1) -1,substr($FORM{$formkey},1)); my %pips = %{ $question_db[$qno]{answers}[$ano] }; foreach my $pip (keys %pips) { $pip = lc($pip); if ($pip ne 'answer') { print "$pip = $pips{$pip}
\n" if ($debug >= 3); $myscore{$pip} += $pips{$pip}; } } $completed_items++ } else { print "--: $formkey = $FORM{$formkey}
\n" if ($debug >= 3) ; } } $completed_form = 1 if ($completed_items >= $number_of_questions); } if ($completed_form) { print "

$cgi_title

\n"; print "Completed form!\n" if ($debug >= 2) ; ## SCORING: ## (a) for each characteristic, get difference ## (b) multiply by the weight ## (c) add to sum print "Your scores:\n" if ($debug >= 2) ; if ($debug >= 1) { ## DEBUG TABLE print "\n\n"; foreach my $trait (sort keys %weight) { print "\n"; } print "\n"; print "\n\n"; foreach my $trait (sort keys %weight) { print "\n"; } foreach my $character (sort keys %character_db) { print "\n\n"; my $sum = 0; foreach my $trait (sort keys %weight) { print "\n"; $sum += abs($character_db{$character}{$trait}); } print "\n"; } print "
Trait list:$trait
(x$weight{$trait})		deviation
YOU:$myscore{$trait}
$character:$character_db{$character}{$trait}$sum
\n"; print "
\n";
    foreach my $trait (sort keys %weight) { print sprintf("%13s => %2d,\n", $trait, $myscore{$trait}); }
    print "
\n"; } foreach my $character (sort keys %character_db) { foreach my $trait (sort keys %weight) { $diffs{$character} += abs( $character_db{$character}{$trait} - $myscore{$trait} ) * $weight{$trait}; } if ($diffs{$character} <= $min) { $min = $diffs{$character}; $minchar = $character; } print "Total for $character: [$diffs{$character}]
\n" if ($debug >= 1); } # $diffs{'dud1'} = 0; # $character_db{'dud1'}{fullname} = 'Dud #1'; my @charlist = (keys %character_db) ; @charlist = sort { $diffs{$a} <=> $diffs{$b} } (@charlist) ; my ($lastscore,$duplicates,$ranking) = (0,0,1); my @topscorers = (); for (my $count = 0; $count < 5; $count++) { if ($lastscore == $diffs{$charlist[$count]}) { $duplicates++; } else { $duplicates = 0; $lastscore = $diffs{$charlist[$count]}; $ranking = $count+1; } if ($ranking == 1) { push(@topscorers,$charlist[$count]); } else { } } print "top scorers: (@topscorers)" if ($debug >= 2); if ($#topscorers) { print "You have " . ($#topscorers + 1) . " top matches:
\n" if ($debug >= 2) ; my $topnumber = 1; foreach my $winner (sort @topscorers) { show_winner("Your \#$topnumber top match is", $winner); $topnumber++; } } else { show_winner('Your best match is', $topscorers[0]); } print "

Your matches, in order, are as follows:\n"; print "
\n"; for (my $count = 0; $count < 5; $count++) { if ($lastscore == $diffs{$charlist[$count]}) { $duplicates++; } else { $duplicates = 0; $lastscore = $diffs{$charlist[$count]}; $ranking = $count+1; } if ($ranking == 1) { push(@topscorers,$charlist[$count]); print "$ranking: $character_db{$charlist[$count]}{fullname}
"; } else { print "$ranking: $character_db{$charlist[$count]}{fullname}
"; } } print "

"; print "

Don't agree with your results? Just hit the 'back' button on your browser and try the test again. Thanks for trying out the $cgi_title! {{{shameless plug}}} And don't forget - if you want to find out more about Slayers, check out Slayers Universe!"; } else { ## print the form print <$cgi_title

This test will attempt to determine which character from Slayers is the closest match for your own personality. If you've no idea what Slayers is, well, you're in the right place! Just click here to find out about the anime!) Just complete the following sentences and we'll tell you who your best match could be!

EOF if ($completed_items > 0) { print "

You did not fill out all of the answers. Please select a radio button for each question and resubmit your answers.

\n"; } for my $inc ( 0 .. $#question_db ) { my $qno = $inc+1; print "\n\n"; my @answers = @{ $question_db[$inc]{'answers'} }; print "\n"; } print "\n\n"; print "\n"; print "\n
$qno. $question_db[$inc]{'question'}
\n"; for my $ano ( 0 .. $#answers ) { if ($FORM{"q$qno"} eq "a$ano") { print " $answers[$ano]->{answer}
\n"; } else { print " $answers[$ano]->{answer}
\n"; } } print "
 
\n"; } # print "Lina's name is $character_db{lina}{fullname}.\n"; print <

$cgi_title programmed by xelloss. $cgi_title questions created by xelloss and tdj. These tests are intended for fun and should in no way be misconstrued as psychiatric advice. In other words, if you actually were any of these characters, we'd be really concerned!

Anime - Books - Multimedia - Background --- Resources - Production --- Search - Contact
Last modified: 2001.12.19 (Wed)
This page (http://www.inverse.org/tests/slayers) is part of Slayers Universe
Slayers copyright (c) 1989-2001 Hajime Kanzaka / Rui Araizumi / Kadokawa Shoten / TV TOKYO / SOFTX / Marubeni
Page content is copyright (c)1997-2001 by Xelloss
HTML and scripting are copyright (c)1997-2001 by Xelloss (Andre Germain)
and are not to be altered or reproduced without permission.
EOF sub show_winner { my ($intro, $character) = ($_[0],$_[1]); print "

$intro $character_db{$character}{fullname}!
\n"; print "\"If

\n"; print "

To add this image to your webpage or journal, simply copy-and-paste the following HTML code:
\n"; print "

\n"; } ############################################################################ # # # parse_form() Version 1.6 # # Written by Matthew Wright mattw@worldwidemart.com # # Created 9/30/96 Last Modified 3/2/98 # # # # Copyright 1997 Craig Patchett & Matthew Wright. All Rights Reserved. # # This subroutine is part of The CGI/Perl Cookbook from John Wiley & Sons. # # License to use this program or install it on a server (in original or # # modified form) is granted only to those who have purchased a copy of The # # CGI/Perl Cookbook. (This notice must remain as part of the source code.) # # # # Function: Takes form field data from a POST or GET request and # # converts it to name/value pairs in the %FORM array or, # # if a corresponding entry in the %CONFIG array is defined, # # in %CONFIG. # # # # Usage: &parse_form; # # # # Variables: None # # # # Returns: 0 if invalid request method # # 1 if successful # # # # Uses Globals: Sets %CONFIG with name/value pairs if corresponding entry # # in %CONFIG is defined # # Otherwise sets entries in %FORM # # $Error_Message for descriptive error messages # # # # Files Created: None # # # ############################################################################ sub parse_form { my($name, $value, $pair, $buffer, @pairs); # Check for request method and handle appropriately if ($ENV{'REQUEST_METHOD'} eq 'GET') { @pairs = split(/&/, $ENV{'QUERY_STRING'}); } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); @pairs = split(/&/, $buffer); } else { $Error_Message = "Bad request method ($ENV{'REQUEST_METHOD'}). Use POST or GET"; return(0); } # Convert the data to its original format foreach $pair (@pairs) { ($name, $value) = split(/=/, $pair); $name =~ tr/+/ /; $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $name =~ s/\n//g; $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s/\n//g; # If they try to include server side includes, erase them, so they # arent a security risk if the HTML gets returned. Another # security hole plugged up. $value =~ s///g; # Store name/value pair in %CONFIG if the corresponding entry is # defined if ($CONFIG{$name} && $CONFIG_INIT{$name}) { $CONFIG{$name} .= ",$value"; } elsif (defined($CONFIG{$name})) { $CONFIG{$name} = $CONFIG_INIT{$name} = $value; } # Otherwise store in %FORM elsif ($FORM{$name}) { $FORM{$name} .= ",$value"; } else { $FORM{$name} = $value; } } return(1); }