Difference between revisions of "User:Seph Swain/perl"

From Second Life Wiki
Jump to navigation Jump to search
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 first 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.
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), does some version checking with user notification and logs 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)

Revision as of 02:08, 27 April 2007

Here's a first 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), does some version checking with user notification and logs 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&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!
 
   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