CGI:IRC

package nonjs; use strict; use vars qw/@ISA $standardheader/; $standardheader = < == Released under the GNU GPL --> EOF # nonjs always uses first server.. if(defined $::config->{balance_servers}) { my @s = split /,\s*/, $::config->{balance_servers}; $::config->{script_form} = "$s[0]/$::config->{script_form}"; $::config->{script_nph} = "$s[0]/$::config->{script_nph}"; } use default; @ISA = qw/default/; my %output_none; sub new { my($class,$event,$timer, $config, $icookies) = @_; my $self = bless {}, $class; $timer->addforever(code => \&todo, data => $self, interval => 10); $event->add('user 005', code => sub { $self->{':_prefix'} = "$_[1] " } ); $self->{':_timestamp'} = 0; $self->{':_timestamp'}++ if exists $icookies->{timestamp} && $icookies->{timestamp}; if(exists $::config->{'output none'}) { @output_none{split /,\s*/, $::config->{'output none'}} = 1; } return $self; } sub _out { unless(print "$_[1]\r\n") { $::needtodie++; } } sub _reloadreal { my($w) = @_; print "\r\n"; } sub _escape { my($in) = @_; $in =~ s//>/g; $in =~ s/"/"/g; return $in; } sub reload { my($self, $w) = @_; $self->{':_reload'} = $w; } sub todo { my($timer, $self) = @_; if(defined $self->{':_reload'} && $self->{':_reload'}) { _reloadreal($self->{':_reload'}); delete($self->{':_reload'}); } } sub exists { return 0 if $_[1] =~ /^_/; return 0 if $_[1] eq 'header'; return 1 if defined &{__PACKAGE__ . '::' . $_[1]}; } sub query { return 0; } sub smilie { shift; return " $\"$_[2]\"$ "; } sub link { shift; return "$_[1]"; } sub header { my($self, $config, $cgi, $bg, $fg) = @_; print < CGI:IRC EOF } sub makeline { my($self, $info, $html) = @_; my $target = $info->{target}; $target ||= 'Status'; if(not exists $self->{lc $target} && $target ne 'Status') { if(defined $info && ref $info && exists $info->{create} && $info->{create}) { $self->add($target, $info->{type} eq 'join' ? 1 : 0); } }elsif($info->{type} eq 'join') { $self->reload('u'); } return if exists $output_none{$info->{type}}; if($self->{':_timestamp'}) { my($sec,$min,$hour) = localtime; $html = sprintf("[%02d:%02d] %s", $hour, $min, $html); } return $html . '
'; } sub lines { my($self, @lines) = @_; $self->_out($_) for @lines; } sub line { my($self, $line) = @_; $self->_out($self->makeline({}, $line)); } sub add { my($self, $name, $param) = @_; $self->{':_target'} ||= lc $name; $self->{lc $name} = $param; $self->_out(''); } sub del { my($self, $name) = @_; delete($self->{$name}); $self->reload('f'); } sub active { my($self, $name) = @_; $self->{':_target'} = $name; $self->reload('f'); } sub error { my($self,$message) = @_; $self->line($message); } sub help { my($self) = shift; $self->line("Full help can be found at http://cgiirc.org/docs/usage.php"); } sub frameset { my($self, $scriptname, $config, $random, $out, $interface) = @_; print < CGI:IRC This interface requires a browser that supports frames such as internet explorer, netscape or mozilla. EOF } sub fuserlist { my($self, $cgi, $config) = @_; my $r = _escape($cgi->{R}); print < Loading.. EOF } sub _page { return '' . $_[0] . "\r\n"; } sub userlist { my($self, $input, $irc, $config) = @_; if(!defined $self->{':_target'} || !$irc->is_channel($self->{':_target'})) { return _page('No channel'); } my $channel = $irc->channel($self->{':_target'}); return _page('No channel') unless ref $channel; my $output = 'Users in ' . _escape($channel->{name}) . '
'; my @users = map($channel->get_umode($_) . $_, $channel->nicks); my $umap = '@%+ '; if($self->{':_prefix'}) { $umap = $self->{':_prefix'}; } for(sort { # (I think this is clever :-) my($am,$bm) = (substr($a, 0, 1), substr($b, 0, 1)); return $a cmp $b if ($am eq $bm); return index($umap, $am) <=> index($umap, $bm); } @users) { $output .= "{script_form}?R=$input->{R}&item=userlist&cmd=say&say=/query+" . substr($_, 1) . "\">$_
"; } return _page($output); } sub fform { my($self, $cgi, $config) = @_; print _form_out($cgi->{R}, $config->{script_form}, undef, {}); } sub form { my($self, $cgi, $irc, $config) = @_; if(defined $cgi->{target} && $cgi->{target} && $cgi->{target} ne $self->{':_target'}) { $self->{':_target'} = $cgi->{target}; $self->reload('u'); } return _form_out($cgi->{R}, $config->{script_form}, $self->{':_target'}, $self); } sub _form_out { my($rand, $script, $target, $targets) = @_; $rand = _escape($rand); my $out = < EOF return $out; } 1;