PHAT-CLIENT TUTORIAL
The following briefly overviews several Perl scripts used by the Multi-Agent Management (MAM) system, all of which get executed from a UNIX environment running on a Sun OS. PLEASE REALIZE that it is intended primarily for programmers who want to have an understanding of the server-side scripting unique to the MAM environment.
None of these scripts are critical to MAM during runtime. For the most part, the agent system will continue to operate fine without them, though some functionality will be lost.
QUICK LINKS: Server-Side Scripts
- Account Activation
- Agent Login
- Translation
- Phat-Client Tutorial: Menuing and Functionality
- Phat-Client Tutorial: Agent Attributes
- Phat-Client Tutorial: Custom Look & Feel
- Phat-Client Tutorial: [for programmers] Packages and Agent Types
- Phat-Client Tutorial: [for programmers] Messaging and Agent Layers
- Phat-Client Tutorial: [for programmers] MUE/MOO and MAM interfaces
- Phat-Client Tutorial: [for programmers] MUE/MOO Game and Utility Code
- Phat-Client Tutorial: [for programmers] Server-Side Scripts
- Phat-Client Tutorial: [for programmers] MAM UML Documentation
- Phat-Client Tutorial: [for programmers] MAM Javadocs
- PROXY portal
- Agent Login
ACCOUNT ACTIVATION
In order to properly use the MAM system you must go to a URL and activate an agent via an HTML form. The form collects some basic demographic data about the user, and then asks a series of 18 questions to generate a score for three different psychological attributes: alienation, ambition, and anxiety. The HTML form gets processed server-side by the following Perl script:
#!/usr/bin/perl
#----------------------------------------------------------------
# Define Variables.
#----------------------------------------------------------------
$filename = '/path/file.html';
$endurl = '/path/file.html';
$database = '/path/file.txt';
$remote_mail = 1; # 1 = Yes; 0 = No
$mailprog = '/usr/lib/sendmail';
$recipient = 'nideffer@uci.edu';
print "Content-type: text/html\n\n";
#----------------------------------------------------------------
# Print out what we want to have accessible via HTML for admin.
#----------------------------------------------------------------
# Get the input
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
# Split the name-value pairs
@pairs = split(/&/, $buffer);
foreach $pair (@pairs)
{
($name, $value) = split(/=/, $pair);
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Stop people from using subshells to execute commands
$value =~ s/~!/ ~!/g;
# Uncomment for debugging purposes
# print "Setting $name to $value‹P›";
$FORM{$name} = $value;
}
#----------------------------------------------------------------
# Here's where we check to see if user name (etc...) is taken.
#----------------------------------------------------------------
open(DB_CHECK, "‹$database") || die "Can't open file!";
$duplicateFound = 0;
$userNameCheck = $FORM{'user'};
while (‹DB_CHECK›) {
if( /^.*:.*:$userNameCheck:.*/ )
{
$errorMessage = "ERROR! The user name that you have provided: \"‹I›$userNameCheck‹/I›,\" is already registered by ‹B›PROXY‹/B›. Please ‹A HREF=\"javascript:history.back()\"›return to the agent activation form‹/A› and provide another.\n";
$duplicateFound = 1;
}
}
close (DB_CHECK);
if( $duplicateFound )
{
print "‹HTML›\n";
print "‹HEAD›\n";
print "‹TITLE›PROXY error‹\/TITLE›\n";
print "‹LINK REL=STYLESHEET TYPE=text/css HREF=\"http://path/style.css\"›\n";
print "‹/HEAD›\n";
print "‹BODY›\n";
print "$errorMessage";
print "‹/BODY›";
print "‹/HTML›";
exit;
}
#----------------------------------------------------------------
# Next comes creating the data file for the submission.
#----------------------------------------------------------------
open (FILE, ">>$filename");
print FILE "Name: ";
print FILE "$FORM{'name'}\n";
print FILE "‹BR›";
print FILE "E-Mail Address: ";
print FILE "$FORM{'email'}\n";
print FILE "‹BR›";
print FILE "Phone Number: ";
print FILE "$FORM{'phone'}\n";
print FILE "‹BR›";
print FILE "FAX Number: ";
print FILE "$FORM{'fax'}\n";
print FILE "‹BR›";
print FILE "Operating System: ";
print FILE "$FORM{'os'}\n";
print FILE "‹BR›";
print FILE "Browser Type: ";
print FILE "$FORM{'browser'}\n";
print FILE "‹BR›";
print FILE "User Name: ";
print FILE "$FORM{'user'}\n";
print FILE "‹BR›‹BR›";
print FILE "‹I›Agent Customization Information‹/I›\n";
%attributes = calcAttributes();
print FILE "‹BR›‹BR›";
print FILE "‹I›Alienation:‹/I›\n";
print FILE "‹BR›";
print FILE "001: [perceive] ";
print FILE "$FORM{'perceive'}\n";
print FILE "‹BR›";
print FILE "002: [strangers] ";
print FILE "$FORM{'strangers'}\n";
print FILE "‹BR›";
print FILE "003: [socializing] ";
print FILE "$FORM{'socializing'}\n";
print FILE "‹BR›";
print FILE "004: [communicate] ";
print FILE "$FORM{'communicate'}\n";
print FILE "‹BR›";
print FILE "005: [support] ";
print FILE "$FORM{'support'}\n";
print FILE "‹BR›";
print FILE "006: [groups] ";
print FILE "$FORM{'groups'}\n";
print FILE "‹BR›";
print FILE "alienation=$attributes{'alienation'}\n";
print FILE "‹BR›‹BR›";
print FILE "‹I›Ambition:‹/I›\n";
print FILE "‹BR›";
print FILE "007: [destroy] ";
print FILE "$FORM{'destroy'}\n";
print FILE "‹BR›";
print FILE "008: [limelight] ";
print FILE "$FORM{'limelight'}\n";
print FILE "‹BR›";
print FILE "009: [envious] ";
print FILE "$FORM{'envious'}\n";
print FILE "‹BR›";
print FILE "010: [resent] ";
print FILE "$FORM{'resent'}\n";
print FILE "‹BR›";
print FILE "011: [harm] ";
print FILE "$FORM{'harm'}\n";
print FILE "‹BR›";
print FILE "012: [lie] ";
print FILE "$FORM{'lie'}\n";
print FILE "‹BR›";
print FILE "ambition=$attributes{'ambition'}\n";
print FILE "‹BR›‹BR›";
print FILE "‹I›Anxiety:‹/I›\n";
print FILE "‹BR›";
print FILE "013: [angry] ";
print FILE "$FORM{'angry'}\n";
print FILE "‹BR›";
print FILE "014: [crying] ";
print FILE "$FORM{'crying'}\n";
print FILE "‹BR›";
print FILE "015: [tense] ";
print FILE "$FORM{'tense'}\n";
print FILE "‹BR›";
print FILE "016: [unstable] ";
print FILE "$FORM{'unstable'}\n";
print FILE "‹BR›";
print FILE "017: [palpitations] ";
print FILE "$FORM{'palpitations'}\n";
print FILE "‹BR›";
print FILE "018: [ringing] ";
print FILE "$FORM{'ringing'}\n";
print FILE "‹BR›";
print FILE "anxiety=$attributes{'anxiety'}\n";
print FILE "‹BR›‹BR›\n";
$last_updated = localtime(time);
print FILE "Submit on: ‹I›$last_updated‹/I›\n";
print FILE "‹/P›";
print FILE "‹HR NOSHADE SIZE=1›\n";
close (FILE);
#----------------------------------------------------------------
# Here's where we write out the HTML after submitting.
#----------------------------------------------------------------
open (FILE, "$endurl");
while (‹FILE›) {print;}
close FILE;
#----------------------------------------------------------------
# Here's where we write name, email, user, psswd to a text db.
#----------------------------------------------------------------
if ($database ne '') {
%attributes = calcAttributes();
open (DATABASE,">>$database");
print DATABASE "$FORM{'name'}:";
print DATABASE "$FORM{'email'}:";
print DATABASE "$FORM{'user'}:";
print DATABASE "$FORM{'passwd'}:";
print DATABASE "alienation=$attributes{'alienation'};ambition=$attributes{'ambition'};anxiety=$attributes{'anxiety'}\n";
close(DATABASE);
}
#----------------------------------------------------------------
# Here's where we send email to the applicant.
#----------------------------------------------------------------
if ($remote_mail eq '1' && $FORM{'email'}) {
open (MAIL, "|$mailprog -t") || die "Can't open $mailprog!\n";
print MAIL "To: $FORM{'email'}\n";
print MAIL "From: $recipient\n";
print MAIL "Subject: PROXY agent activation\n";
print MAIL "\n";
print MAIL "Your PROXY agent has been activated...\n";
print MAIL "\n";
print MAIL " Your username is: $FORM{'user'}\n";
print MAIL " Your password is: $FORM{'passwd'}\n";
print MAIL "\n";
print MAIL "Please save your username and password in a secure location.
print MAIL "\n";
print MAIL "If you have not already done so, you may download the agent system from:\n";
print MAIL "\n";
print MAIL " http://proxy.arts.uci.edu/agents/download/\n";
print MAIL "\n";
print MAIL "Good luck!\n\n";
close (MAIL);
}
#----------------------------------------------------------------
# Here's where we send email to the administrator.
#----------------------------------------------------------------
if ($remote_mail eq '1' && $FORM{'email'}) {
open (MAIL, "|$mailprog -t") || die "Can't open $mailprog!\n";
print MAIL "To: $recipient\n";
print MAIL "From: $FORM{'email'}\n";
print MAIL "Subject: PROXY agent requested\n";
print MAIL "\n";
print MAIL "$FORM{'name'} has requested an agent...\n";
print MAIL "\n";
print MAIL " The chosen username is: $FORM{'user'}\n";
print MAIL " The chosen password is: $FORM{'passwd'}\n\n";
close (MAIL);
}
#----------------------------------------------------------------
# Here's where we calculate agent attributes.
#----------------------------------------------------------------
sub calcAttributes {
my( $alienationScore, $ambitionScore, $anxietyScore, $attr );
#calc alienation - just average values (for now)
$alienationScore += valFromString( $FORM{'perceive'} );
$alienationScore += valFromString( $FORM{'strangers'} );
$alienationScore += valFromString( $FORM{'socializing'} );
$alienationScore += valFromString( $FORM{'communicate'} );
$alienationScore += valFromString( $FORM{'support'} );
$alienationScore += valFromString( $FORM{'groups'} );
$alienationScore = $alienationScore / 6;
#same for ambition
$ambitionScore += valFromString( $FORM{'destroy'} );
$ambitionScore += valFromString( $FORM{'limelight'} );
$ambitionScore += valFromString( $FORM{'envious'} );
$ambitionScore += valFromString( $FORM{'resent'} );
$ambitionScore += valFromString( $FORM{'harm'} );
$ambitionScore += valFromString( $FORM{'lie'} );
$ambitionScore = $ambitionScore / 6;
#same for anxiety
$anxietyScore += valFromString( $FORM{'angry'} );
$anxietyScore += valFromString( $FORM{'crying'} );
$anxietyScore += valFromString( $FORM{'tense'} );
$anxietyScore += valFromString( $FORM{'unstable'} );
$anxietyScore += valFromString( $FORM{'palpitations'} );
$anxietyScore += valFromString( $FORM{'ringing'} );
$anxietyScore = $anxietyScore / 6;
$attr{ 'alienation' } = $alienationScore;
$attr{ 'ambition' } = $ambitionScore;
$attr{ 'anxiety' } = $anxietyScore;
return %attr;
}
sub valFromString {
my( $text ) = @_;
my $result = -1;
SWITCH: { $_ = $text;
if( /^Almost Never$/i ) { $result = 0; last SWITCH; };
if( /^Rarely$/i ) { $result = 1; last SWITCH; };
if( /^Sometimes$/i ) { $result = 2; last SWITCH; };
if( /^Quite Often$/i ) { $result = 3; last SWITCH; };
if( /^Most of the Time$/i ) { $result = 4; last SWITCH; };
}
return $result;
}
The script is pretty straight forward. First a few variables are defined for referencing and writing files and sending email notifications. Then comes some general admin stuff, followed by a check to see if a particular user name is already in use. If so, an error page gets created and displayed. What happens next is the script takes all the variables entered in the HTML form and stores them for writing to an HTML page that records all registrants. The script also creates a raw .txt db for storing critical user info (name, email, username, password, and attribute scores), and fires off a couple emails, one to the applicant, and another to the administrator. The last thing the script does is calculate a value for the attribute scores based on the answers provided in the HTML form.
AGENT LOGIN
This Perl script is designed to grab the attribute scores for the agent from the raw .txt file written to during registration. This only happens during the first login to the MAM system due to the fact that an 'agents.xml' file does not yet exist, as it gets written to your local file system on shutdown.
#!/usr/bin/perl
$cgiArgs = $ENV{'QUERY_STRING'};
$userName = $cgiArgs;
$responseBody = "";
$users_db = "/path/file.txt";
open users_db or die "can't open $users_db";
while( ‹users_db› )
{
if( /\S*:\S*:$userName:\S*:(\S*)=(\S*);(\S*)=(\S*);(\S*)=(\S*)/ )
{
$responseBody = "‹?xml version=\"1.0\"?›‹traits›‹trait name=\"$1\" value=\"$2\" /›‹trait name=\"$3\" value=\"$4\" /›‹trait name=\"$5\" value=\"$6\n\" /›‹/traits›";
}
}
$responseLength = length $responseBody;
print "Content-type: text/xml\n\n$responseBody\n";
Basically the script greps through the raw .txt file looking for the username, and then the attribute scores stored for that user. If the script fails for some reason, default attribute scores will be used.
TRANSLATION
This one gets a bit trickier. It's a total hack. We're essentially using the Perl script to do translation of all real-time MOO chat from English to one of five languages (French, Italian, Portuguese, Spanish, and German), or to English from one of three languages (French, Spanish, and German). We do the same for all HTML pages viewed or displayed from within MOO. We use two different translation services to get the task done: one for the chat (Babelfish); and another for the HTML pages (FreeTranslation).
#!/usr/bin/perl
#handles both straight text and urls
#gets the appropriate text translation from babelfish.altavista.com
#displays the appropriate url translation from www.freetranslation.com
use IO::Socket;
#global constants
$CUSTOM_ERROR_FILE = "error.html";
$FILE_INSERT_TAG = "‹BABEL_FRAMES_ERROR›‹/BABEL_FRAMES_ERROR›";
#replace this with the appropriate value if running on a different server
$THIS_SERVER = "server/script.pl";
#global variables
$langPair = "";
$transTarget = "";
$webPageRequest = 0; #false
$cgiArgs = $ENV{'QUERY_STRING'};
#declare subroutines
sub parseArgs{
#parse the cgiArgs global variable to get the language pair and the translation target
my @temp = split /\+/, $cgiArgs;
$langPair = shift @temp;
$transTarget = join '+', @temp; #put everything in @temp back into one variable
$webPageRequest = ($transTarget =~ /^http/); #does it start with 'http'?
}
sub doTranslation{
$transServer = "babel.altavista.com";
$host = $transServer;
$port = 80;
if( $webPageRequest )
{
if( $langPair eq "en_fr" )
{
$langPair = "English%2FFrench";
}
if( $langPair eq "en_it" )
{
$langPair = "English%2FItalian";
}
if( $langPair eq "en_pt" )
{
$langPair = "English%2FPortuguese";
}
if( $langPair eq "en_es" )
{
$langPair = "English%2FSpanish";
}
if( $langPair eq "en_de" )
{
$langPair = "English%2FGerman";
}
if( $langPair eq "fr_en" )
{
$langPair = "French%2FEnglish";
}
if( $langPair eq "es_en" )
{
$langPair = "Spanish%2FEnglish";
}
if( $langPair eq "de_en" )
{
$langPair = "German%2FEnglish";
}
$transServer = "fets3.freetranslation.com";
$port = 5081;
$translated_url = "$transServer:$port/?Language=$langPair&Url=$transTarget&Sequence=core";
#write out the redirect
print "Location: http://$translated_url\n";
print "Content-type: text/plain\n";
print "Content-length: 19\n\n";
print "Translation failure";
return;
}
$translated_url = "$transServer:$port/";
$transSocket = IO::Socket::INET->new( Proto => "tcp",
PeerAddr => "$host:$port" ) or die "can't open socket";
if( $webPageRequest )
{
$bblValue = "url";
$urlParam = "url";
}
else
{
$bblValue = "text";
$urlParam = "text";
}
$content = "doit=done&tt=urltext&urltext=$transTarget&lp=$langPair";
$contentLength = length $content;
$httpRequest = "POST /tr HTTP/1.1\r\n".
"Host: $host\r\n".
"Accept: image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/vnd.ms-excel, application/msword, application/vnd.ms-powerpoint, application/x-comet, */*\r\n".
"Referer: http://babel.altavista.com/tr\r\n".
"Accept-Language: en-us\r\n".
"Content-Type: application/x-www-form-urlencoded\r\n".
"Accept-Encoding: gzip, deflate\r\n".
"User-Agent: Mozilla/4.0 (compatible; Perl; Windows NT 4.0)\r\n".
"Connection: close\r\n".
"Content-length: $contentLength\r\n".
"\r\n".
"$content";
#send the request
print $transSocket "$httpRequest";
$babelResponseText = "";
while( $line = ‹$transSocket› )
{
$babelResponseText = $babelResponseText.$line;
}
close ($transSocket);
$finalText = parseResponse($babelResponseText);
$responseLength = length $finalText;
#send response
if( $webPageRequest )
{
print "Content-type: text/html\n";
}
else
{
print "Content-type: text/plain\n";
}
print "Content-length: $responseLength\n".
"\n".
"$finalText\n";
}
sub parseResponse{
my($text) = @_;
if( $webPageRequest )
{
return parseResponseWebPage( $text );
}
else
{
return parseResponseText( $text );
}
}
sub parseResponseWebPage{
use integer;
my @transResponse = split /\n/, @_[0];
my $i = 0;
while( @transResponse[$i] ne "" )
{
$i++;
}
my $responseLength = scalar(@transResponse);
my $translatedPage = join "\n", @transResponse[ ($i+1)..$responseLength ];
print "debug: translated page: \n$translatedPage \n";
$translatedPage=~/sessionid=(.*?);path=/ms;
print "cookie is $1\n";
return $translatedPage;
}
sub handleFramesError{
use integer;
my($serverPage) = @_;
#grab the list of sub frames
my @subFrames = $serverPage=~/‹li›‹a href="\/cgi-bin\/translate\?urltext=.*?"›(http:\/\/.*?)‹\/a›‹br›/gs;
my $numFrames = scalar(@subFrames);
my $i;
#turn each sub frame into an appropriate link for inclusion in the response page
for( $i=0; $i‹$numFrames; $i++ )
{
$subFrames[$i]=~s/(http:\/\/.*)/‹a href="http:\/\/$THIS_SERVER\?$langPair\+$1"›$1‹\/a›/gm;
}
my $finalFrames = join "‹br›", @subFrames;
#read error page
open( ERRORFILE, "$CUSTOM_ERROR_FILE" );
my @rawError = ‹ERRORFILE›;
my $errorPage = join "", @rawError;
#insert list of links at tag
$errorPage=~s/$FILE_INSERT_TAG/$finalFrames/;
return $errorPage;
}
sub parseResponseText{
my($tempPage) = @_;
$START_TAG = '‹textarea rows="3" wrap=virtual cols="56" name="q"›';
$END_TAG = '‹/textarea›';
$tempPage=~/$START_TAG(.*?)$END_TAG/s;
my $translated_text;
$translated_text = $1;
if( $translated_text eq "" )
{
$NEW_START_TAG = '‹td bgcolor=white›';
$NEW_END_TAG = '‹/td›';
$tempPage=~/$NEW_START_TAG(.*?)$NEW_END_TAG/ms;
$translated_text = $1;
}
$translated_text=~s/\n/ /g;
$translated_text=~s/\l/ /g;
$translated_text=~s/\r/ /g;
$translated_text =~ s/^\s*(.*?)\s*$/$1/;
return $translated_text;
}
parseArgs();
doTranslation();
This is the kind of script that breaks whenever something changes at one of the service providers getting hacked into. It's essentially a bunch of dependent checks to look for particular portions of the parsed text returned after the string to translate has been processed by the remote server. It does this in order to display just the translated text, and not all the other garbage that comes back with it. It can be a real crap-shoot. Believe it or not, it's been pretty solid for a couple years now (knock on wood).
However there are a few things you can do when the script breaks due to formatting changes. To fix normal translation, you need to modify the '$START_TAG' and '$END_TAG' variables at the beginning of the 'parseResponseText()' subroutine. You may also need to update '$NEW_START_TAG' and '$NEW_END_TAG' also. The challenge consists of finding the HTML that gets generated immediately before and after the translated text you're looking for, and then putting that HTML as the values of the variables. Finally, you may also have to change some of the URL variables in 'doTranslation()', depending on whether any of the services change the parameters their scripts expect.
Please send comments to nideffer@uci.edu.
