User:Seph Swain/perl

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 /<td/i, $_;
      my $cell_count = int(@cells);
      #print STDERR "entry: " . int(@cells) ."\n";
      @cells = map {
	s/^[^>]*>//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