';
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
SQLRunner
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 7700X
CISC 7512X
CISC 7500X
IT Mngmt (old)
SW (old)
Networks (old)
OS (old)
AI (old)
App Dev (old)
C++ (old)
OOP (old)
Web (old)
Perl (old)
DBMS (old)
ProgLangs (old)
PHP (old)
MltMedia (old)
Oracle (old)
Misc
Privacy Policy
Publications
profphreak.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-2024 by End of the World Production, LLC. |
';
push @theoutput,' | |