';
push @theoutput,'
 www.theparticle.com
Main
Services
Products
Resources
Forum
About Us
Contact
Particle Revelation
Hardware Destruction
Quotes
Humor [alpha]
Murphy\'s Laws
Programming
Java
Java Data Structures
C# Data Structures
Database Design
Graphics Tutorial
Artificial Intelligence
Downloads
Graphics Tutorials
 Hacking Tutorials
Java Applets
MIDI Music
Gov & Misc Docs
Games
Chess Game
Asteroids
Tic-Tac-Toe
Tetris
Applets
DRAW!
FlightBox
pWobble 3D
pRunner
NYU HWs
Swarms
Geometry
Chaos
Machine Learning
Academic
CISC 7332X (LAN)
DB Sys (old)
C++ (old)
 OOP (old)
OS (old)
Web (old)
Perl (old)
DBMS (old)
Perl (old)
ProgLangs (old)
PHP (old)
MltMedia (old)
Oracle (old)
Misc
Privacy Policy
Publications
profphreak.com
wr0k.com
';
push @theoutput,' |
|
Prof.Phreak
';
# read input form
read(STDIN,$input,$ENV{'CONTENT_LENGTH'});
@pairs = split(/&/,$input);
push @pairs,split(/&/,$ENV{'QUERY_STRING'});
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s/\0//g;
$value =~ s///g;
$FORM{$name} = $value;
}
#
# Experimental version of Prof.Phreak POC2
#
# Copyright(c) 2001, Particle Corporation
#
local %prof_phreak_environment;
# hashes the value of a number into it's name.
%numberToWordHash = ("0"=>"zero","1"=>"one","2"=>"two",
"3"=>"three","4"=>"four","5"=>"five","6"=>"six","7"=>"seven","8"=>"eight","9"=>"nine",
"10"=>"ten","11"=>"eleven","12"=>"twelve","13"=>"thirteen",
"14"=>"fourteen","15"=>"fifteen","16"=>"sixteen",
"17"=>"seventeen","18"=>"eighteen","19"=>"nineteen",
"20"=>"twenty","30"=>"thirty","40"=>"forty","50"=>"fifty",
"60"=>"sixty","70"=>"seventy","80"=>"eighty","90"=>"ninety",
"100"=>"hundred","1000"=>"thousand","1000000"=>"million",
"1000000000"=>"billion");
# hashes a 'name' into the actual numeric symbol.
# (note, hashes 'open' and 'close' ... this may not
# be appropriate in all contexts
%wordToNumberHash = ("zero"=>0,"one"=>1,"two"=>2,
"three"=>3,"four"=>4,"five"=>5,"six"=>6,"seven"=>7,"eight"=>8,"nine"=>9,
"ten"=>10,"eleven"=>11,"twelve"=>12,"thirteen"=>13,
"fourteen"=>14,"fifteen"=>15,"sixteen"=>16,
"seventeen"=>17,"eighteen"=>18,"nineteen"=>19,
"twenty"=>20,"thirty"=>30,"forty"=>40,"fifty"=>50,
"sixty"=>60,"seventy"=>70,"eighty"=>80,"ninety"=>90,
"hundred"=>100,"thousand"=>1000,"million"=>1000000,
"billion"=>1000000000,"open"=>'(',"close"=>')',
"plus"=>'+',"minus"=>'-',
"times"=>'*',"divide"=>'/');
# keywords used in expressions... (used to breakup
# input into an expression and remove all other 'junk')
@numericalWords = ("zero","one","two",
"three","four","five","six","seven","eight","nine",
"ten","eleven","twelve","thirteen",
"fourteen","fifteen","sixteen",
"seventeen","eighteen","nineteen",
"twenty","thirty","forty","fifty",
"sixty","seventy","eighty","ninety",
"hundred","thousand","million","billion",
"negative","plus","minus",
"divide","times","open","close");
# keyword symbols. (same use as above; seperate because
# used differently in constructing a regular expression)
@symbols = ('(','/','*','+','-',')');
# create proper regular expressions (longest first)
my @numericalWords = sort {length($b) <=> length($a)} @numericalWords;
$numericalWordsRE = join '|',@numericalWords;
foreach(@numericalWords){
$numericalWordsHash{$_} = $_;
}
# --------------------------------------------
# check whether input is a symbol.
sub isexpressionsymbol {
my ($symb) = @_;
foreach(@symbols){
if($symb =~ m/(\Q$_\E)/){
return 1;
}
}
return 0;
}
# --------------------------------------------
# second conversion step
sub computeNumber2 {
local ($arr_ref,$n,$bound) = @_;
local @arr = @{$arr_ref};
local $tmp=0;
local $number = 0;
for($n--;$n >= 0;){
if(((($tmp=$arr[$n]) % 100) != 0) || $arr[$n] == 0){
$number += $arr[$n--];
}elsif($bound >= $arr[$n]){
local $res = computeNumber2(\@arr,$n,$tmp);
$number += $tmp * ${$res}[0];
$n = ${$res}[1];
}else{
last;
}
}
local @tarr;
$tarr[0] = $number == 0 ? 1:$number; # fixed? ;needs more testing.
$tarr[1] = $n;
return \@tarr;
}
# ------------------------------------------------
# routine to convert a bunch of numbers in an
# array into a composite number...
sub convertNumber {
local @input = @_;
local $i;
local $tmp=0;
local $number=0;
# simple case first
if($#input == 0){
return $input[0];
}
# get number's sign (and get rid of all the "negative" strings out of the array.
my $sign=1;
for($i=0;$i<=$#input;$i++){
if($input[$i] eq "negative"){
$sign=-1;
splice @input,$i,1;
}
}
# go though the first step conversion process
for($i=$#input;$i >= 0;){
if(((($tmp=$input[$i]) % 100) != 0) || $tmp == 0){
$number += $input[$i--];
} else {
local $res = computeNumber2(\@input,$i,$tmp);
$number += $tmp * ${$res}[0];
$i = ${$res}[1];
}
}
return $sign * $number;
}
# --------------------------------------------------------------------
# check the parenthesis within the expression
sub check_parenthesis {
my ($arr_ref) = @_;
my @arr = @{$arr_ref};
my $i;
my $count=0;
for($i=0;$i<=$#arr;$i++){
if($arr[$i] eq '('){
$count++;
}elsif($arr[$i] eq ')'){
if($count == 0){
$count = 1;
last;
}else{
$count--;
}
}
}
return $count == 0 ? 1:0;
}
# -------------------------------------------------------------
# convert an infix expression to post fix
sub infix_to_postfix {
my ($arr_ref) = @_;
my @arr = @{$arr_ref};
splice @{$arr_ref};
my @stack;
my $i;
for($i=0;$i<=$#arr;$i++){
my $var = $arr[$i];
if($var =~ m/[0-9]+/){
push @{$arr_ref},$var;
}elsif($var eq '+'|| $var eq '-' || $var eq '*' || $var eq '/'){
if($#stack < 0){
push @stack, $var;
}else{
my $sp = pop @stack;
if($sp eq '(' || $sp eq ')'){
push @stack,$sp;
push @stack,$var;
}else{
if( ($sp eq '+' || $sp eq '-') &&
($var eq '*' || $var eq '/')){
push @stack,$sp;
push @stack,$var;
}else{
push @stack,$var;
push @{$arr_ref},$sp;
}
}
}
}elsif($var eq '(' || $var eq ')'){
if($var eq '('){
push @stack,$var;
}elsif($var eq ')'){
while($#stack >= 0){
my $sp = pop @stack;
if($sp ne '('){
push @{$arr_ref},$sp;
}else{
last;
}
}
}
}else{
return 0;
}
}
while($#stack >= 0){
my $sp = pop @stack;
push @{$arr_ref},$sp;
}
return 1;
}
# -------------------------------------------------------
# evaluate a postfix expression...
sub solve_postfix_expression {
my ($arr_ref) = @_;
my @arr = @{$arr_ref};
my @stack;
my $i;
my $var;
for($i=0;$i<=$#arr;$i++){
$var = $arr[$i];
if($var =~ m/[0-9]+/){
push @stack,$var;
}else{
if($#stack < 0){
$prof_phreak_environment{"input.math.expression.solved"}=0;
return 0;
}
my $a = pop @stack;
if($#stack < 0){
$prof_phreak_environment{"input.math.expression.solved"}=0;
return 0;
}
my $b = pop @stack;
my $tmp = 0;
if($var eq '+'){
$tmp = $b + $a;
}elsif($var eq '-'){
$tmp = $b - $a;
}elsif($var eq '*'){
$tmp = $b * $a;
}elsif($var eq '/'){
# check division by zero
if($a == 0){
$prof_phreak_environment{"input.math.expression.division_by_zero"}=$b;
return 0;
}
$tmp = $b / $a;
}else{
$prof_phreak_environment{"input.math.expression.solved"}=0;
return 0;
}
push @stack,$tmp;
}
}
if($#stack < 0){
$prof_phreak_environment{"input.math.expression.solved"}=0;
return 0;
}
$var = pop @stack;
if($#stack >= 0){
$prof_phreak_environment{"input.math.expression.solved"}=0;
return 0;
}
splice @{$arr_ref};
@{$arr_ref}[0] = $var;
return 1;
}
# -------------------------------------------------------------------------
# 3rd level helper function for number->word conversion
sub convert_number_to_words3 {
local ($number,$v) = @_;
local $rem = $number % 100;
if(($number - $rem) > 0){
local $n = ($number - $rem) / 100;
if(defined $numberToWordHash{"$n"}){
push @{$v},$numberToWordHash{"$n"};
push @{$v},"hundred";
}
}
if($rem != 0){
if(defined $numberToWordHash{"$rem"}){
push @{$v},$numberToWordHash{"$rem"};
}else{
my $rem2 = $rem % 10;
my $tmp = $rem - $rem2;
if(defined $numberToWordHash{"$tmp"}){
push @{$v},$numberToWordHash{"$tmp"};
}
if(defined $numberToWordHash{"$rem2"}){
push @{$v},$numberToWordHash{"$rem2"};
}
}
}
}
# -------------------------------------------------------------------------------------
# helping function in number->word conversion
sub convert_number_to_words2 {
local ($number,$what,$v) = @_;
local $rem = $number % ($what * 1000);
if(($number - $rem) > 0){
convert_number_to_words2($number - $rem,$what*1000,$v);
}
if($rem != 0){
$rem /= $what;
convert_number_to_words3($rem,$v);
if($what > 1){
if(defined $numberToWordHash{"$what"}){
push @{$v},$numberToWordHash{"$what"};
}
}
}
}
# ----------------------------------------------------------------------------
# convert a number back to word representation (support decimals)
sub convert_number_to_words {
local ($number) = @_;
local @v;
if($number == 0){
push @v,"zero";
}else{
if($number < 0){
push @v,"negative";
$number = -$number;
}
my $whole = int $number;
convert_number_to_words2($whole,1,\@v);
# get decimal, and write it (if it exists)
my $part_of_whole = (int(($number - $whole) * 10000))/10000;
if($part_of_whole != 0){
# put code to print the decimal point
push @v,"point";
$part_of_whole =~ s/[0-9]+\.|0+$//g;
my @chars = unpack "c*",$part_of_whole;
for($i=0;$i<=$#chars && $i<3;$i++){
push @v,$numberToWordHash{chr($chars[$i])};
}
# continue number 'forever'
if($i<=$#chars){
push @v,"..."
}
}
}
return @v;
}
# -------------------------------------------------------------------
# check size of a number using 'bits of numbers'...
sub numberSizeOk {
my @input = @_;
my $count = 0;
foreach(@input){
my $str = "$_";
$count += length $str;
}
return $count > 32 ? 0:1;
}
#----------------------------------------------------------------------------------------
# process the expression (parse out numbers, change expression, evaluate (if possible))
sub process_expression {
local ($input) = @_;
local $i;
# check if there are any numbers with more than 12 digits
if($input =~ m/[0-9]{15,}/){
$prof_phreak_environment{"input.math.expression.number_out_of_range"}=1;
return;
}
# get rid of all words that have number words as their substring
open(NUMBER_WORDS,"){
chomp;
$input =~ s/$_//g;
}
close(NUMBER_WORDS);
# give symbols some space
foreach(@symbols){
$input =~ s/(\Q$_\E)/ \1 /g;
}
# give numbers (less than 12 digits) some space
$input =~ s/(([0-9]+)(.[0-9]+)?)/ \1 /g;
# give word numbers (ie: 'one' 'two', etc.) some space
$input =~ s/($numericalWordsRE)/ \1 /g;
# go through the input, and get rid of anything that's not part of an 'expression'
@input = split ' ',$input;
for($i=0;$i<=$#input;){
if(defined $numericalWordsHash{$input[$i]} ||
isexpressionsymbol($input[$i]) ||
$input[$i]=~m/(([0-9]+)(.[0-9]+)?)/){
# change the 'word' representation into a number (not finished yet)
if(defined $wordToNumberHash{$input[$i]}){
$input[$i] = $wordToNumberHash{$input[$i]};
}
$i++;
}else{
splice @input,$i,1;
}
}
# create an expression by joining 'number bits' into larger number
# using operators as delimiters.
my @currentNumber;
my @inputExpression;
for($i=0;$i<=$#input;$i++){
if($input[$i] eq '(' || $input[$i] eq ')' || $input[$i] eq '+' ||
$input[$i] eq '-' || $input[$i] eq '*' || $input[$i] eq '/'){
if($#currentNumber >= 0){
# check to make sure the resulting number is 12 digits or less
if(!numberSizeOk(@currentNumber)){
$prof_phreak_environment{"input.math.expression.number_out_of_range"}=1;
return;
}
push @inputExpression, convertNumber(@currentNumber);
splice @currentNumber;
}
push @inputExpression,$input[$i];
}else {
push @currentNumber,$input[$i];
}
}
if($#currentNumber >= 0){
# check to make sure the resulting number is 12 digits or less
if(!numberSizeOk(@currentNumber)){
$prof_phreak_environment{"input.math.expression.number_out_of_range"}=1;
return;
}
push @inputExpression, convertNumber(@currentNumber);
splice @currentNumber;
}
@input = @inputExpression;
undef @inputExpression;
# if nothing on input by this time, there is no rexpression.
return unless $#input >= 0;
# check to see if it's a singleton; or if no expression
if($#input == 0){
if($input[0] =~ m/(([0-9]+)(.[0-9]+)?)/){
my @result = convert_number_to_words ($input[0]);
$prof_phreak_environment{"input.math.expression.singleton"} = join ' ',@result;
}
return;
}
# if expression has no numbers, return (no expression)
my $flag=0;
foreach(@input){
if(/[0-9]+/){
$flag=1;
last;
}
}
return unless $flag;
# if parenthesis don't match
if(!check_parenthesis(\@input)){
$prof_phreak_environment{"input.math.expression.parenthesis.match"}=0;
return;
}
# convert the infix expression to postfix
if(!infix_to_postfix(\@input)){
$prof_phreak_environment{"input.math.expression.infix_to_postfix"}=0;
return;
}
# solve the postfix expression (result is first element of array)
if(!solve_postfix_expression(\@input)){
return;
}
# convert result to words, and return
my @result = convert_number_to_words ($input[0]);
$prof_phreak_environment{"input.math.expression.result.word"} = join ' ',@result;
}
#--------------------------------------------------------------------
local @from = ("are you","you are","my", "your","me", "i am", "am i", "i", "myself", "you");
local @to = ( "I am", "I am", "your","my", "you","you are", "you are", "you","yourself","I");
local $db_load_count = 0;
#-------------------------------------------------------------------
# given name, loads database. returns reference to db
sub load_database {
my ($dbname) = @_;
# load database of simple keywords
open(IN,"<$dbname") || die;
my $db_ref;
while(){
chomp;
s/^\s+|\s+$//g;
s/^\/\/.*$//g;
next unless length;
my ($keywords,$keyvalues,$code) = split /##/;
my $obj = bless {};
my @keywords = split /#/,$keywords;
my @keyvalues = split /#/,$keyvalues;
# enable easier space matching (if there is a space, match 0 or more spaces)
for($i=0;$i<=$#keywords;$i++){
$keywords[$i] =~ s/\s+/\\s\*/g;
}
$obj->{keywords} = \@keywords;
$obj->{keyvalues} = \@keyvalues;
$obj->{code} = $code;
$obj->{id} = $db_load_count++;
push @{$db_ref},$obj;
}
return $db_ref;
}
# ----------------------------------------------------------------------
# get reply
sub getreply {
my ($s,$db_ref) = @_;
my $r;
my @match_list;
# search for a match
REFLOOP: for($db_ref_index=0;$db_ref_index<=$#{$db_ref};$db_ref_index++){
$obj = ${$db_ref}[$db_ref_index];
my @keywords = @{$obj->{keywords}};
for($keywords_index=0;$keywords_index<=$#keywords;$keywords_index++){
$_ = $keywords[$keywords_index];
if($s =~ m/($_)/){
$obj->{s} = length $1;
my @vars = ($2,$3,$4,$5,$6,$7,$8,$9);
# get rid of spaces in matched variables
for($i=0;$i<=$#vars;$i++){
$vars[$i] =~ s/^\s*|\s*$//g;
}
$obj->{vars} = \@vars;
push @match_list,$obj;
next REFLOOP;
}
}
}
# (longer string matches get precedense over few letters matching)
if($#match_list >= 0){
# find max
$obj = $match_list[0];
for($i=1;$i<=$#match_list;$i++){
if($obj->{s} < $match_list[$i]->{s}){
$obj = $match_list[$i];
}
}
my @keyvalues = @{$obj->{keyvalues}};
my $storage_tmp_filename = "/tmp/theparticle_cgi_shared_tmp.dbm";
dbmopen(%NUMBS,$storage_tmp_filename,0600);
$number = int $NUMBS{ $obj->{id} };
if($number > $#keyvalues){
$number = 0;
}
$r = $keyvalues[$number++];
$NUMBS{ $obj->{id} } = $number;
dbmclose(%NUMBS);
# process code fragments (the code works with (and replaces) @vars)
if(defined $obj->{code}){
my @vars = @{$obj->{vars}};
eval($obj->{code});
# get rid of spaces in matched variables
for($i=0;$i<=$#vars;$i++){
$vars[$i] =~ s/^\s*|\s*$//g;
}
$obj->{vars} = \@vars;
}
# do variable replacements
my @vars = @{$obj->{vars}};
for($i=0;$i<=$#vars;$i++){
for($j=0;$j<=$#from;$j++){
last if $vars[$i] =~ s/^$from[$j]\s/$to[$j] /g;
last if $vars[$i] =~ s/^$from[$j]$/$to[$j]/g;
last if $vars[$i] =~ s/\s$from[$j]\s/ $to[$j] /g;
last if $vars[$i] =~ s/\s$from[$j]$/ $to[$j]/g;
}
$j = $i+1;
$r =~ s/\$$j/$vars[$i]/g;
}
}
return $r;
}
sub doreplies {
my ($s) = @_;
my $r = getreply($s,load_database("phreak_c.db"));
if(!length $r){
$r = getreply($s,load_database("phreak_s.db"));
}
if(!length $r){
$r = getreply($s,load_database("phreak_t.db"));
}
return $r;
}
$_ = $FORM{'u'};
if(!length){
$_ = "Hello.";
}
$u = $_;
%prof_phreak_environment = ();
$input = $_ = lc;
process_expression (" $_ ");
$_ = $input;
s/^\s*|\s*$//g;
s/\.|\,|\!|\?//g;
s/\s+/ /g;
s/\'re/ are/g;
s/\'m/ am/g;
s/\'d/ would/g;
s/can\'t/can not/g;
s/won\'t/will not/g;
s/n\'t/ not/g;
s/'s/ is/g;
s/'ve/ have/g;
s/^\s*|\s*$//g;
$input = " $_ ";
my $input_more = "";
while (($key,$value) = each %prof_phreak_environment) {
$input_more = "$input_more :$key=$value: ";
print "key-value: $key=$value\n";
}
$input = "$input $input_more";
$r = doreplies($input);
$formdata = $FORM{'o'};
# monitor conversations so that we can improve the database
open(OUT,">>profphreak.log");
$tim = scalar localtime();
print OUT "U($tim): $u\nP($tim): $r\n";
close(OUT);
push @theoutput,'You: ';
push @theoutput,"$u";
push @theoutput,'
Prof.Phreak: ';
push @theoutput,"$r";
push @theoutput,'
';
# get rid of CR from CRLF pair (the CR causes another extra LF in textarea)
$formdata =~ s/\x0D//g;
$formdata =~ s/\x0A+/\x0A/g;
if(length $formdata){
$conversation_log = "$formdata\nYou: $u\nProf.Phreak: $r";
}else{
$conversation_log = "You: $u\nProf.Phreak: $r";
}
push @theoutput,'
restart conversation
To learn more about Prof.Phreak, visit the main Prof.Phreak page.
';
push @theoutput,'
 |
© 1996-2012 by End of the World Production, LLC. |
';
push @theoutput,' | |
