Difference between revisions of "User:Seph Swain/perl"
Jump to navigation
Jump to search
Seph Swain (talk | contribs) |
Seph Swain (talk | contribs) |
||
Line 1: | Line 1: | ||
Here's a frist example of how to make server side CGI scripts to interact with SL objects. | Here's a frist example of how to make server side CGI scripts to interact with SL objects. | ||
This one retrieves information via HTTP from different sources and answeres requests from SL Objects like Displays or HUDs (objects can be found in-world via my picks). | This one retrieves information via HTTP from different sources and answeres requests from SL Objects like Displays or HUDs (objects can be found in-world via my picks) and loggs some usage and propagation data from you objects. | ||
(Unfortunatly the Wiki-Formating doesn't really work for this, if you know how to fix it, please tell me) | (Unfortunatly the Wiki-Formating doesn't really work for this, if you know how to fix it, please tell me) | ||
Line 93: | Line 93: | ||
$out = substr($out, 0, 2048); | $out = substr($out, 0, 2048); | ||
print "Content-type: text/html\n\n$out\n"; | print "Content-type: text/html\n\n$out\n"; | ||
EOF |
Revision as of 02:06, 27 April 2007
Here's a frist example of how to make server side CGI scripts to interact with SL objects. This one retrieves information via HTTP from different sources and answeres requests from SL Objects like Displays or HUDs (objects can be found in-world via my picks) and loggs some usage and propagation data from you objects.
(Unfortunatly the Wiki-Formating doesn't really work for this, if you know how to fix it, please tell me)
#!/usr/bin/perl # # multi purpose WWW->SL Gateway require 5; use LWP::Simple; use CGI; use POSIX('strftime'); # Config Section my %VERSION = ( 'MyControl HUD Translator' => 0.02, 'LineGraph' => 0.9, ); # EOC # global variables my $out = "ERROR"; # collect input data my $query = new CGI; my $action = $query->param("action"); my $client_version = $query->param("version"); my $client_object_name = $ENV{"HTTP_X_SECONDLIFE_OBJECT_NAME"}; $client_object_name =~ s/ v[\d\.]*$//o; my $client_owner_name = $ENV{"HTTP_X_SECONDLIFE_OWNER_NAME"}; #foreach (sort keys %ENV) { print STDERR "$_ = $ENV{$_}\n"; } # some logging: print STDERR (strftime "%F %T", localtime) . " $client_object_name [v${client_version}]" . " (owner: $client_owner_name)\n"; # version checking: if ($client_version < $VERSION{$client_object_name}) { $out = "Version expired. New Version $VERSION{$client_object_name} " . "available from MyControl"; $action = "error"; } if ($action eq 'SL-online-now') { my $html = get("http://www.secondlife.com/"); my $total = $1 if $html =~ /.*Total Residents:.*\n.*>([\d,]{1,})</; $total =~ s/,//go; my $online = $1 if $html =~ /.*Online Now:.*\n.*>([\d,]{1,})</; $online =~ s/,//go; $out = join(';', $online, $total); } elsif ($action eq 'dict.leo.org') { # version checking: my $word = $query->param("word"); my $language = $query->param("language"); my $language_str = "ende"; # 0-englisch(default), 1-franzoesisch, 2-spanisch if ($language == 1) { $language_str = "frde" } elsif ($language == 2) { $language_str = "esde" } my $html = get("http://dict.leo.org/${language_str}?lp=${language_string}&lang=de&searchLoc=0&cmpType=relaxed§Hdr=on&spellToler=on&relink=on&search=$word"); #print STDERR "HTML:\n$html\n"; my $content; $content = $1 if $html =~ /<table[^>]*id="results"[^>]*>(.*?)<\/table>/s; # no i! my @entries = split /\<tr/i, $content; # remove leading and trailing 2 entries: #@entries = splice(@entries, 2, -2); my @out; foreach (@entries) {
my @cells = split /]*>//o;
s/<[^>]*>//go; $_; } @cells;
if ($cell_count == 6) { push @out, $cells[2] . " - " . $cells[4]; } } if (@out) { $out = join("\n", @out); } else { $out = "no results"; } } # cut to size $out = substr($out, 0, 2048); print "Content-type: text/html\n\n$out\n";
EOF