Add a QDB command
authorpdbogen <pdbogen@088b83a4-0077-4247-935c-42ec02c2848b>
Thu, 11 Sep 2008 04:22:09 +0000 (04:22 +0000)
committerpdbogen <pdbogen@088b83a4-0077-4247-935c-42ec02c2848b>
Thu, 11 Sep 2008 04:22:09 +0000 (04:22 +0000)
git-svn-id: https://www.cernu.us/~pdbogen/svn/destult2@59 088b83a4-0077-4247-935c-42ec02c2848b

commands.yaml

index 0bd9951..02565f2 100644 (file)
@@ -786,6 +786,58 @@ BASH: |-
     }
   }
 
+QDB: |-
+  sub {
+    my( $kernel, $heap, $who, $what, $src, $dest, $replypath ) = @_;
+  
+    unless( $what =~ /^([0-9]+)|(random)$/ ) {
+      $kernel->post( $src, $replypath, "Quote # should be a postive integer.", $dest );
+      return;
+    }
+
+    use LWP::UserAgent;
+    my $ua = LWP::UserAgent->new;
+    my $req = HTTP::Request->new( GET => 'http://qdb.us/?'.$what );
+    my $res = $ua->request( $req );
+    my @quotes;
+    if( $res->is_success ) {
+      my $content = $res->content;
+      $content =~ s/[\n\r]//g;
+  
+      if( $content =~ s/<table[^>]*?class="quote">(.*?)<\/table>//i ) {
+        my $table = $1;
+        my( $num, $body );
+        while( $table =~ s/<tr[^>]*>(.*?)<\/tr>//i ) {
+          my $text = $1;
+          $text =~ s/<br \/>/\n/gi;
+          $text =~ s/<[^>]*>//gi;
+          $text =~ s/&lt;/</gi;
+          $text =~ s/&gt;/>/gi;
+          $text =~ s/&amp;/&/gi;
+          $text =~ s/&quot;/"/gi;
+          $text =~ s/&nbsp;/ /gi;
+          if( $text =~ /^(#[0-9]+)/ ) {
+               $num = $1;
+          } elsif( $text eq "-+" ) {
+            if( defined $num && defined $body ) {
+              push @quotes, [$num, $body];
+            }
+            undef $num;
+            undef $body;
+          } else {
+            $body = $text;
+          }
+        }
+        my $quote = $quotes[ int(rand($#quotes+1)) ];
+        $kernel->post( $src, $replypath, $quote->[0].":\n".$quote->[1], $dest );
+      } else {
+        $kernel->post( $src, $replypath, "No quotes found in response.", $dest );
+      }
+    } else {
+      $kernel->post( $src, $replypath, "Something happened: ".$res->status_line, $dest );
+    }
+  }
+
 TRANSLATE: |-
   sub {
     use Lingua::Translate;