html/chansearch.pl

package main
EOF
   1 #!/usr/bin/perl
   2 #
   3 # by Stefan 'tommie' Tomanek <stefan@pico.ruhr.de>
   4 
   5 use strict;
   6 
   7 use vars qw($VERSION %IRSSI);
   8 $VERSION = '20021019';
   9 %IRSSI = (
  10     authors     => 'Stefan \'tommie\' Tomanek',
  11     contact     => 'stefan@pico.ruhr.de',
  12     name        => 'ChanSearch',
  13     description => 'searches for specific channels',
  14     license     => 'GPLv2',
  15     url         => 'http://scripts.irssi.org/',
  16     changed     => $VERSION,
  17     modules     => 'Data::Dumper LWP::UserAgent POSIX',
  18 );
  19 
  20 use Irssi 20020324;
  21 use LWP::UserAgent;
  22 use Data::Dumper;
  23 use POSIX;
  24 
  25 use vars qw($forked);
  26 
  27 $forked = 0;
  28 
  29 sub draw_box ($$$$) {
  30     my ($title, $text, $footer, $colour) = @_;
  31     my $box = '';
  32     $box .= '%R,--[%n%9%U'.$title.'%U%9%R]%n'."\n";
  33     foreach (split(/\n/, $text)) {
  34         $box .= '%R|%n '.$_."\n";
  35     }
  36     $box .= '%R`--<%n'.$footer.'%R>->%n';
  37     $box =~ s/%.//g unless $colour;
  38     return $box;
  39 }
  40 
  41 sub fork_search ($) {
  42     my ($query) = @_;
  43     my ($rh, $wh);
  44     pipe($rh, $wh);
  45     return if $forked;
  46     my $pid = fork();
  47     $forked = 1;
  48     if ($pid > 0) {
  49 	close($wh);
  50 	Irssi::pidwait_add($pid);
  51 	my $pipetag;
  52 	my @args = ($rh, \$pipetag);
  53 	$pipetag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, \@args);
  54 	print CLIENTCRAP "%R>>%n Please wait...";
  55     } else {
  56 	my %result;
  57 	$result{query} = $query;
  58 	$result{result} = search_channels($query);
  59 	my $dumper = Data::Dumper->new([\%result]);
  60 	$dumper->Purity(1)->Deepcopy(1);
  61 	my $data = $dumper->Dump;
  62 	print($wh $data);
  63 	close($wh);
  64 	POSIX::_exit(1);
  65    }
  66 }
  67 
  68 sub pipe_input ($$) {
  69     my ($rh, $pipetag) = @{$_[0]};
  70     my $data;
  71     $data .= $_ foreach (<$rh>);
  72     close($rh);
  73     Irssi::input_remove($$pipetag);
  74     return unless($data);
  75     no strict;
  76     my %result = %{ eval "$data" };
  77     my $text;
  78     foreach (sort keys %{ $result{result} }) {
  79         $text .= '%9'.$_.'%9, '.$result{result}{$_}->{nicks}." nicks\n";
  80         $text .= '   "'.$result{result}{$_}->{topic}.'"'."\n" if $result{result}{$_}->{topic};
  81     }
  82     $forked = 0;
  83     print CLIENTCRAP draw_box('ChanSearch', $text, $result{query}, 1);
  84 }
  85 
  86 sub search_channels ($) {
  87     my ($query) = @_;
  88     my $ua = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1,timeout => 30);
  89     $ua->agent('Irssi Chansearch');
  90     my $page = 'http://www.ludd.luth.se/irc/bin/csearch.cgi';
  91     my %form = ( topic => "channels",
  92                  hits => "all",
  93                  min  => 2,
  94 		 max  => "infinite",
  95 		 sort => "in alphabetic order.",
  96 		 pattern => $query
  97 		);
  98     my $result = $ua->post($page, \%form);
  99     return undef unless $result->is_success();
 100     my %channels;
 101     foreach ( split(/\n/, $result->content()) ) {
 102 	if (/^<LI><STRONG>(.*?)<\/STRONG> <I>(\d+)<\/I><BR>(.*).$/) {
 103 	    $channels{$1} = { topic => $3, nicks => $2 };
 104 	}
 105     }
 106     return \%channels;
 107 }
 108 
 109 sub cmd_chansearch ($$$) {
 110     my ($args, $server, $witem) = @_;
 111     fork_search($args);
 112 }
 113 
 114 Irssi::command_bind('chansearch', \&cmd_chansearch);
 115 
 116 print CLIENTCRAP '%B>>%n '.$IRSSI{name}.' '.$VERSION.' loaded';