User:Seph Swain/perl

1. !/usr/bin/perl
3. multi purpose WWW->SL Gateway

require 5; use LWP::Simple; use CGI; use POSIX('strftime');

1. Config Section

 my %VERSION = (
   'MyControl HUD Translator'	=> 0.02,
   'LineGraph'			=> 0.9,
 );

1. EOC

1. global variables

my $out = "ERROR";

1. 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"};

1. foreach (sort keys %ENV) { print STDERR "$_ = $ENV{$_}\n"; }

1. some logging:

print STDERR (strftime "%F %T", localtime) .

            " $client_object_name [v${client_version}]" .

" (owner: $client_owner_name)\n";

1. 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&sectHdr=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";
 }

}

1. cut to size

$out = substr($out, 0, 2048); print "Content-type: text/html\n\n$out\n";