User:Seph Swain/perl
< User:Seph Swain
Jump to navigation
Jump to search
Revision as of 01:53, 27 April 2007 by Seph Swain (talk | contribs)
- !/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! #print STDERR "content:\n$content\n"; #print STDERR "splut:\n"; 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";