[NeoStats-Devel] [Commits] r2678 - in trunk: modules/perltest src

Author: Fish
Date: Tue Jul 19 22:10:23 2005
New Revision: 2678

Modified:
   trunk/modules/perltest/test.pl
   trunk/src/NeoStats.pm
   trunk/src/neostats.pm.h
   trunk/src/perl.c
Log:
Its Tiger Time! (more perl Find* funcs added)

Modified: trunk/modules/perltest/test.pl
==============================================================================
--- trunk/modules/perltest/test.pl	(original)
+++ trunk/modules/perltest/test.pl	Tue Jul 19 22:10:23 2005
@@ -82,6 +82,8 @@
 sub event_server {
 	my ($test) = @_;
 	NeoStats::print ("New Server $test");
+	my $server = NeoStats::FindServer($test);
+	NeoStats::print ("Server Uplink $test->{uplink}");
 }
 
 sub event_squit {
@@ -104,6 +106,7 @@
 	NeoStats::print ("Signon $source");
 	my $user = NeoStats::FindUser($source);
 	NeoStats::print ("Host: $user->{hostname}");
+	NeoStats::print ("Server $user->{server}");
 }
 
 sub event_quit {
@@ -174,6 +177,8 @@
 sub event_join {
 	my ($channel, $source) = @_;
 	NeoStats::print ("Join $channel: $source");
+	my $chan = NeoStats::FindChan($channel);
+	NeoStats::print ("Channel users $chan->{users}");
 }
 
 sub event_part {

Modified: trunk/src/NeoStats.pm
==============================================================================
--- trunk/src/NeoStats.pm	(original)
+++ trunk/src/NeoStats.pm	Tue Jul 19 22:10:23 2005
@@ -103,6 +103,12 @@
       return NeoStats::NS_FAILURE;
     }
   }
+  
+  sub unhook_event {
+    NeoStats::print("todo");
+    return NeoStats::NS_FAILURE;
+  }
+
 
 # AddBot(botinfo, botflag)
   sub AddBot {
@@ -170,167 +176,24 @@
     return NeoStats::Internal::FindUser($nick);
   }
 
-
-
-  sub hook_server {
-    return undef unless @_ >= 2;
-
-    my $message = shift;
-    my $callback = shift;
-    my $options = shift;
-    my ($package) = caller;
-    ($package) = caller(1) if $package eq 'IRC';
-    $callback = NeoStats::Embed::fix_callback( $package, $callback );
-    my ($priority, $data) = ( NeoStats::PRI_NORM, undef );
-  
-    if ( ref( $options ) eq 'HASH' ) {
-      if ( exists( $options->{priority} ) && defined( $options->{priority} ) ) {
-        $priority = $options->{priority};
-      }
-      if ( exists( $options->{data} ) && defined( $options->{data} ) ) {
-        $data = $options->{data};
-      }
-    }
-    
-    my $pkg_info = NeoStats::Embed::pkg_info( $package );
-    my $hook =  NeoStats::Internal::hook_server( $message, $priority, $callback, $data);
-    push @{$pkg_info->{hooks}}, $hook if defined $hook;
-    return $hook;
-
-  }
-
-  sub hook_command {
-    return undef unless @_ >= 2;
-
-    my $command = shift;
-    my $callback = shift;
-    my $options = shift;
-    my ($package) = caller;
-    ($package) = caller(1) if $package eq 'IRC';
-    $callback = NeoStats::Embed::fix_callback( $package, $callback );
-    my ($priority, $help_text, $data) = ( NeoStats::PRI_NORM, '', undef );
-
-    if ( ref( $options ) eq 'HASH' ) {
-      if ( exists( $options->{priority} ) && defined( $options->{priority} ) ) {
-        $priority = $options->{priority};
-      }
-      if ( exists( $options->{help_text} ) && defined( $options->{help_text} ) ) {
-        $help_text = $options->{help_text};
-      }
-      if ( exists( $options->{data} ) && defined( $options->{data} ) ) {
-        $data = $options->{data};
-      }
-    }
-
-    my $pkg_info = NeoStats::Embed::pkg_info( $package );
-    my $hook = NeoStats::Internal::hook_command( $command, $priority, $callback,
-                                     $help_text, $data);
-    push @{$pkg_info->{hooks}}, $hook if defined $hook;
-    return $hook;
-
-  }
-
-  sub hook_print {
-    return undef unless @_ >= 2;
-
-    my $event = shift;
-    my $callback = shift;
-    my $options = shift;
-    my ($package) = caller;
-    ($package) = caller(1) if $package eq 'IRC';
-    $callback = NeoStats::Embed::fix_callback( $package, $callback );
-    my ($priority, $data) = ( NeoStats::PRI_NORM, undef );
-
-    if ( ref( $options ) eq 'HASH' ) {
-      if ( exists( $options->{priority} ) && defined( $options->{priority} ) ) {
-        $priority = $options->{priority};
-      }
-      if ( exists( $options->{data} ) && defined( $options->{data} ) ) {
-        $data = $options->{data};
-      }
+  sub FindServer {
+    if (@_ < 1) {
+      NeoStats::print("Invalid Number of arguments to FindServer");
+      return NeoStats::NS_FAILURE;
     }
-
-    my $pkg_info = NeoStats::Embed::pkg_info( $package );
-    my $hook =  NeoStats::Internal::hook_print( $event, $priority, $callback, $data);
-    push @{$pkg_info->{hooks}}, $hook if defined $hook;
-    return $hook;
-
-  }
-
-
-  sub hook_timer {
-    return undef unless @_ >= 2;
-
-    my ($timeout, $callback, $data) = @_;
-    my ($package) = caller;
-    ($package) = caller(1) if $package eq 'IRC';
-    $callback = NeoStats::Embed::fix_callback( $package, $callback );
- 
-    if ( ref( $data ) eq 'HASH' && exists( $data->{data} )
-         && defined( $data->{data} ) ) {
-      $data = $data->{data};
-    }
-
-    my $pkg_info = NeoStats::Embed::pkg_info( $package );
-    my $hook = NeoStats::Internal::hook_timer( $timeout, $callback, $data );
-    push @{$pkg_info->{hooks}}, $hook if defined $hook;
-    return $hook;
-
+    my $name = shift;
+    return NeoStats::Internal::FindServer($name);
   }
 
-  sub hook_fd {
-    return undef unless @_ >= 2;
-    my ($fd, $callback, $options) = @_;
-    return undef unless defined $fd && defined $callback;
-    my $fileno = fileno $fd;
-    return undef unless defined $fileno; # no underlying fd for this handle
-    
-    my ($package) = caller;
-    ($package) = caller(1) if $package eq 'IRC';
-
-    $callback = NeoStats::Embed::fix_callback( $package, $callback );
-    
-    my ($flags, $data) = (NeoStats::FD_READ, undef);
-    
-    if( ref( $options ) eq 'HASH' ) {
-      if( exists( $options->{flags} ) && defined( $options->{flags} ) ) {
-        $flags = $options->{flags};
-      }
-      if( exists( $options->{data} ) && defined( $options->{data} ) ) {
-        $data = $options->{data};
-      }
+  sub FindChan {
+    if (@_ < 1) {
+      NeoStats::print("Invalid Number of arguments to FindChannel");
+      return NeoStats::NS_FAILURE;
     }
-    
-    my $cb = sub {
-      my $userdata = shift;
-      no strict 'refs';
-      return &{$userdata->{CB}}($userdata->{FD}, $userdata->{FLAGS},
-			       $userdata->{DATA},
-                              );
-    };
-    
-    my $pkg_info = NeoStats::Embed::pkg_info( $package );
-    my $hook = NeoStats::Internal::hook_fd( $fileno, $cb, $flags,
-                                         { DATA => $data, FD => $fd, CB => $callback,
-                                           FLAGS => $flags,
-                                         } );
-    push @{$pkg_info->{hooks}}, $hook if defined $hook;
-    return $hook;
+    my $name = shift;
+    return NeoStats::Internal::FindChannel($name);
   }
   
-  sub unhook {
-    my $hook = shift @_;
-    my $package = shift @_;
-    ($package) = caller unless $package;
-    my $pkg_info = NeoStats::Embed::pkg_info( $package );
-
-    if( $hook =~ /^\d+$/ && grep { $_ == $hook } @{$pkg_info->{hooks}} ) {
-      $pkg_info->{hooks} = [grep { $_ != $hook } @{$pkg_info->{hooks}}];
-      return NeoStats::Internal::unhook( $hook );
-    }
-
-    return ();
-  }
 
   sub print {
 
@@ -343,27 +206,8 @@
         $text = join "", @$text;
       }
     }
-
-  
-    if ( @_ >= 1 ) {
-      my $channel = shift @_;
-      my $server = shift @_;
-      my $old_ctx = NeoStats::get_context();
-      my $ctx = NeoStats::find_context( $channel, $server );
-    
-      if ( $ctx ) {
-        NeoStats::set_context( $ctx );
-        NeoStats::Internal::debug( $text );
-        NeoStats::set_context( $old_ctx );
-        return 1;
-      } else {
-        return 0;
-      }
-    } else {
-      NeoStats::Internal::debug( $text );
-      return 1;
-    }
-
+    NeoStats::Internal::debug( $text );
+    return 1;
   }
 
   sub printf {
@@ -371,105 +215,6 @@
     NeoStats::print( sprintf( $format, @_ ) );
   }
 
-  sub command {
-
-    my $command = shift;
-    my @commands;
-    if ( ref( $command ) eq 'ARRAY' ) {
-      @commands = @$command;
-    } else {
-      @commands = ($command);
-    }
-    if ( @_ >= 1 ) {
-      my ($channel, $server) = @_;
-      my $old_ctx = NeoStats::get_context();
-      my $ctx = NeoStats::find_context( $channel, $server );
-
-      if ( $ctx ) {
-        NeoStats::set_context( $ctx );
-        NeoStats::Internal::command( $_ ) foreach @commands;
-        NeoStats::set_context( $old_ctx );
-        return 1;
-      } else {
-        return 0;
-      }
-    } else {
-      NeoStats::Internal::command( $_ ) foreach @commands;
-      return 1;
-    }
-
-  }
-
-  sub commandf {
-    my $format = shift;
-    NeoStats::command( sprintf( $format, @_ ) );
-  }
-
-  sub set_context {
-    my $context;
-
-    if ( @_ == 2 ) {
-      my ($channel, $server) = @_;
-      $context = NeoStats::find_context( $channel, $server );
-    } elsif ( @_ == 1 ) {
-      if ( $_[0] =~ /^\d+$/ ) {
-        $context = $_[0];
-      } else {
-        $context = NeoStats::find_context( $_[0] );
-      }
-    }
-
-    return $context ? NeoStats::Internal::set_context( $context ) : 0;
-  }
-
-  sub get_info {
-    my $id = shift;
-    my $info;
-  
-    if ( defined( $id ) ) {
-      if ( grep { $id eq $_ } qw(state_cursor) ) {
-        $info = NeoStats::get_prefs( $id );
-      } else {
-        $info = NeoStats::Internal::get_info( $id );
-      }
-    }
-    return $info;
-  }
-
-  sub user_info {
-    my $nick = shift @_ || NeoStats::get_info( "nick" );
-    my $user;
-
-    for (NeoStats::get_list( "users" ) ) {
-      if ( NeoStats::nickcmp( $_->{nick}, $nick ) == 0 ) {
-        $user = $_;
-        last;
-      }
-    }
-    return $user;
-  }
-
-  sub context_info {
-    my $ctx = shift @_ || NeoStats::get_context;
-    my $old_ctx = NeoStats::get_context;
-    my @fields = (qw(away channel host inputbox libdirfs network nick server),
-                  qw(topic version win_status NeoStatsdir NeoStatsdirfs state_cursor),
-                 );
-
-    if (NeoStats::set_context( $ctx )) {
-      my %info;
-      for my $field ( @fields ) {
-        $info{$field} = NeoStats::get_info( $field );
-      }
-      NeoStats::set_context( $old_ctx );
-    
-      return %info if wantarray;
-      return \%info;
-    } else {
-      return undef;
-    }
-  }
-
   sub strip_code {
     my $pattern =
       qr/\cB| #Bold

Modified: trunk/src/neostats.pm.h
==============================================================================
--- trunk/src/neostats.pm.h	(original)
+++ trunk/src/neostats.pm.h	Tue Jul 19 22:10:23 2005
@@ -104,6 +104,12 @@
 "}\n"
 "}\n"
 "\n"
+"sub unhook_event {\n"
+"NeoStats::print(\"todo\");\n"
+"return NeoStats::NS_FAILURE;\n"
+"}\n"
+"\n"
+"\n"
 "\n"
 "sub AddBot {\n"
 "if (@_ < 2) {\n"
@@ -170,167 +176,24 @@
 "return NeoStats::Internal::FindUser($nick);\n"
 "}\n"
 "\n"
-"\n"
-"\n"
-"sub hook_server {\n"
-"return undef unless @_ >= 2;\n"
-"\n"
-"my $message = shift;\n"
-"my $callback = shift;\n"
-"my $options = shift;\n"
-"my ($package) = caller;\n"
-"($package) = caller(1) if $package eq 'IRC';\n"
-"$callback = NeoStats::Embed::fix_callback( $package, $callback );\n"
-"my ($priority, $data) = ( NeoStats::PRI_NORM, undef );\n"
-"\n"
-"if ( ref( $options ) eq 'HASH' ) {\n"
-"if ( exists( $options->{priority} ) && defined( $options->{priority} ) ) {\n"
-"$priority = $options->{priority};\n"
-"}\n"
-"if ( exists( $options->{data} ) && defined( $options->{data} ) ) {\n"
-"$data = $options->{data};\n"
-"}\n"
-"}\n"
-"\n"
-"my $pkg_info = NeoStats::Embed::pkg_info( $package );\n"
-"my $hook =  NeoStats::Internal::hook_server( $message, $priority, $callback, $data);\n"
-"push @{$pkg_info->{hooks}}, $hook if defined $hook;\n"
-"return $hook;\n"
-"\n"
-"}\n"
-"\n"
-"sub hook_command {\n"
-"return undef unless @_ >= 2;\n"
-"\n"
-"my $command = shift;\n"
-"my $callback = shift;\n"
-"my $options = shift;\n"
-"my ($package) = caller;\n"
-"($package) = caller(1) if $package eq 'IRC';\n"
-"$callback = NeoStats::Embed::fix_callback( $package, $callback );\n"
-"my ($priority, $help_text, $data) = ( NeoStats::PRI_NORM, '', undef );\n"
-"\n"
-"if ( ref( $options ) eq 'HASH' ) {\n"
-"if ( exists( $options->{priority} ) && defined( $options->{priority} ) ) {\n"
-"$priority = $options->{priority};\n"
-"}\n"
-"if ( exists( $options->{help_text} ) && defined( $options->{help_text} ) ) {\n"
-"$help_text = $options->{help_text};\n"
-"}\n"
-"if ( exists( $options->{data} ) && defined( $options->{data} ) ) {\n"
-"$data = $options->{data};\n"
-"}\n"
-"}\n"
-"\n"
-"my $pkg_info = NeoStats::Embed::pkg_info( $package );\n"
-"my $hook = NeoStats::Internal::hook_command( $command, $priority, $callback,\n"
-"$help_text, $data);\n"
-"push @{$pkg_info->{hooks}}, $hook if defined $hook;\n"
-"return $hook;\n"
-"\n"
-"}\n"
-"\n"
-"sub hook_print {\n"
-"return undef unless @_ >= 2;\n"
-"\n"
-"my $event = shift;\n"
-"my $callback = shift;\n"
-"my $options = shift;\n"
-"my ($package) = caller;\n"
-"($package) = caller(1) if $package eq 'IRC';\n"
-"$callback = NeoStats::Embed::fix_callback( $package, $callback );\n"
-"my ($priority, $data) = ( NeoStats::PRI_NORM, undef );\n"
-"\n"
-"if ( ref( $options ) eq 'HASH' ) {\n"
-"if ( exists( $options->{priority} ) && defined( $options->{priority} ) ) {\n"
-"$priority = $options->{priority};\n"
-"}\n"
-"if ( exists( $options->{data} ) && defined( $options->{data} ) ) {\n"
-"$data = $options->{data};\n"
-"}\n"
-"}\n"
-"\n"
-"my $pkg_info = NeoStats::Embed::pkg_info( $package );\n"
-"my $hook =  NeoStats::Internal::hook_print( $event, $priority, $callback, $data);\n"
-"push @{$pkg_info->{hooks}}, $hook if defined $hook;\n"
-"return $hook;\n"
-"\n"
-"}\n"
-"\n"
-"\n"
-"sub hook_timer {\n"
-"return undef unless @_ >= 2;\n"
-"\n"
-"my ($timeout, $callback, $data) = @_;\n"
-"my ($package) = caller;\n"
-"($package) = caller(1) if $package eq 'IRC';\n"
-"$callback = NeoStats::Embed::fix_callback( $package, $callback );\n"
-"\n"
-"if ( ref( $data ) eq 'HASH' && exists( $data->{data} )\n"
-"&& defined( $data->{data} ) ) {\n"
-"$data = $data->{data};\n"
-"}\n"
-"\n"
-"my $pkg_info = NeoStats::Embed::pkg_info( $package );\n"
-"my $hook = NeoStats::Internal::hook_timer( $timeout, $callback, $data );\n"
-"push @{$pkg_info->{hooks}}, $hook if defined $hook;\n"
-"return $hook;\n"
-"\n"
-"}\n"
-"\n"
-"sub hook_fd {\n"
-"return undef unless @_ >= 2;\n"
-"my ($fd, $callback, $options) = @_;\n"
-"return undef unless defined $fd && defined $callback;\n"
-"my $fileno = fileno $fd;\n"
-"return undef unless defined $fileno; # no underlying fd for this handle\n"
-"\n"
-"my ($package) = caller;\n"
-"($package) = caller(1) if $package eq 'IRC';\n"
-"\n"
-"$callback = NeoStats::Embed::fix_callback( $package, $callback );\n"
-"\n"
-"my ($flags, $data) = (NeoStats::FD_READ, undef);\n"
-"\n"
-"if( ref( $options ) eq 'HASH' ) {\n"
-"if( exists( $options->{flags} ) && defined( $options->{flags} ) ) {\n"
-"$flags = $options->{flags};\n"
-"}\n"
-"if( exists( $options->{data} ) && defined( $options->{data} ) ) {\n"
-"$data = $options->{data};\n"
+"sub FindServer {\n"
+"if (@_ < 1) {\n"
+"NeoStats::print(\"Invalid Number of arguments to FindServer\");\n"
+"return NeoStats::NS_FAILURE;\n"
 "}\n"
+"my $name = shift;\n"
+"return NeoStats::Internal::FindServer($name);\n"
 "}\n"
 "\n"
-"my $cb = sub {\n"
-"my $userdata = shift;\n"
-"no strict 'refs';\n"
-"return &{$userdata->{CB}}($userdata->{FD}, $userdata->{FLAGS},\n"
-"$userdata->{DATA},\n"
-");\n"
-"};\n"
-"\n"
-"my $pkg_info = NeoStats::Embed::pkg_info( $package );\n"
-"my $hook = NeoStats::Internal::hook_fd( $fileno, $cb, $flags,\n"
-"{ DATA => $data, FD => $fd, CB => $callback,\n"
-"FLAGS => $flags,\n"
-"} );\n"
-"push @{$pkg_info->{hooks}}, $hook if defined $hook;\n"
-"return $hook;\n"
+"sub FindChan {\n"
+"if (@_ < 1) {\n"
+"NeoStats::print(\"Invalid Number of arguments to FindChannel\");\n"
+"return NeoStats::NS_FAILURE;\n"
 "}\n"
-"\n"
-"sub unhook {\n"
-"my $hook = shift @_;\n"
-"my $package = shift @_;\n"
-"($package) = caller unless $package;\n"
-"my $pkg_info = NeoStats::Embed::pkg_info( $package );\n"
-"\n"
-"if( $hook =~ /^\\d+$/ && grep { $_ == $hook } @{$pkg_info->{hooks}} ) {\n"
-"$pkg_info->{hooks} = [grep { $_ != $hook } @{$pkg_info->{hooks}}];\n"
-"return NeoStats::Internal::unhook( $hook );\n"
+"my $name = shift;\n"
+"return NeoStats::Internal::FindChannel($name);\n"
 "}\n"
 "\n"
-"return ();\n"
-"}\n"
 "\n"
 "sub print {\n"
 "\n"
@@ -343,133 +206,15 @@
 "$text = join \"\", @$text;\n"
 "}\n"
 "}\n"
-"\n"
-"\n"
-"if ( @_ >= 1 ) {\n"
-"my $channel = shift @_;\n"
-"my $server = shift @_;\n"
-"my $old_ctx = NeoStats::get_context();\n"
-"my $ctx = NeoStats::find_context( $channel, $server );\n"
-"\n"
-"if ( $ctx ) {\n"
-"NeoStats::set_context( $ctx );\n"
-"NeoStats::Internal::debug( $text );\n"
-"NeoStats::set_context( $old_ctx );\n"
-"return 1;\n"
-"} else {\n"
-"return 0;\n"
-"}\n"
-"} else {\n"
 "NeoStats::Internal::debug( $text );\n"
 "return 1;\n"
 "}\n"
 "\n"
-"}\n"
-"\n"
 "sub printf {\n"
 "my $format = shift;\n"
 "NeoStats::print( sprintf( $format, @_ ) );\n"
 "}\n"
 "\n"
-"sub command {\n"
-"\n"
-"my $command = shift;\n"
-"my @commands;\n"
-"if ( ref( $command ) eq 'ARRAY' ) {\n"
-"@commands = @$command;\n"
-"} else {\n"
-"@commands = ($command);\n"
-"}\n"
-"if ( @_ >= 1 ) {\n"
-"my ($channel, $server) = @_;\n"
-"my $old_ctx = NeoStats::get_context();\n"
-"my $ctx = NeoStats::find_context( $channel, $server );\n"
-"\n"
-"if ( $ctx ) {\n"
-"NeoStats::set_context( $ctx );\n"
-"NeoStats::Internal::command( $_ ) foreach @commands;\n"
-"NeoStats::set_context( $old_ctx );\n"
-"return 1;\n"
-"} else {\n"
-"return 0;\n"
-"}\n"
-"} else {\n"
-"NeoStats::Internal::command( $_ ) foreach @commands;\n"
-"return 1;\n"
-"}\n"
-"\n"
-"}\n"
-"\n"
-"sub commandf {\n"
-"my $format = shift;\n"
-"NeoStats::command( sprintf( $format, @_ ) );\n"
-"}\n"
-"\n"
-"sub set_context {\n"
-"my $context;\n"
-"\n"
-"if ( @_ == 2 ) {\n"
-"my ($channel, $server) = @_;\n"
-"$context = NeoStats::find_context( $channel, $server );\n"
-"} elsif ( @_ == 1 ) {\n"
-"if ( $_[0] =~ /^\\d+$/ ) {\n"
-"$context = $_[0];\n"
-"} else {\n"
-"$context = NeoStats::find_context( $_[0] );\n"
-"}\n"
-"}\n"
-"\n"
-"return $context ? NeoStats::Internal::set_context( $context ) : 0;\n"
-"}\n"
-"\n"
-"sub get_info {\n"
-"my $id = shift;\n"
-"my $info;\n"
-"\n"
-"if ( defined( $id ) ) {\n"
-"if ( grep { $id eq $_ } qw(state_cursor) ) {\n"
-"$info = NeoStats::get_prefs( $id );\n"
-"} else {\n"
-"$info = NeoStats::Internal::get_info( $id );\n"
-"}\n"
-"}\n"
-"return $info;\n"
-"}\n"
-"\n"
-"sub user_info {\n"
-"my $nick = shift @_ || NeoStats::get_info( \"nick\" );\n"
-"my $user;\n"
-"\n"
-"for (NeoStats::get_list( \"users\" ) ) {\n"
-"if ( NeoStats::nickcmp( $_->{nick}, $nick ) == 0 ) {\n"
-"$user = $_;\n"
-"last;\n"
-"}\n"
-"}\n"
-"return $user;\n"
-"}\n"
-"\n"
-"sub context_info {\n"
-"my $ctx = shift @_ || NeoStats::get_context;\n"
-"my $old_ctx = NeoStats::get_context;\n"
-"my @fields = (qw(away channel host inputbox libdirfs network nick server),\n"
-"qw(topic version win_status NeoStatsdir NeoStatsdirfs state_cursor),\n"
-");\n"
-"\n"
-"if (NeoStats::set_context( $ctx )) {\n"
-"my %info;\n"
-"for my $field ( @fields ) {\n"
-"$info{$field} = NeoStats::get_info( $field );\n"
-"}\n"
-"NeoStats::set_context( $old_ctx );\n"
-"\n"
-"return %info if wantarray;\n"
-"return \\%info;\n"
-"} else {\n"
-"return undef;\n"
-"}\n"
-"}\n"
-"\n"
 "sub strip_code {\n"
 "my $pattern =\n"
 "qr/\\cB| #Bold\n"

Modified: trunk/src/perl.c
==============================================================================
--- trunk/src/perl.c	(original)
+++ trunk/src/perl.c	Tue Jul 19 22:10:23 2005
@@ -207,7 +207,8 @@
 			ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->channel->name, cmdparams->source->name);
 			break;
 		case EVENT_PART:
-			ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 3, cmdparams->channel->name, cmdparams->source->name, cmdparams->param);
+			/* XXX Something wrong here */
+			ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 2, cmdparams->channel->name, cmdparams->source->name, cmdparams->param);
 			break;
 		case EVENT_PARTBOT:
 			ret = execute_perl(mod_ptr, mod_ptr->event_list[evt]->pe->callback, 3, cmdparams->channel->name, cmdparams->source->name, cmdparams->param);
@@ -318,6 +319,8 @@
 		newSVpv(u->user->userhostmask, strlen(u->user->userhostmask)), 0);
 	hv_store(client, "uservhostmask", 13, 
 		newSVpv(u->user->uservhostmask, strlen(u->user->uservhostmask)), 0);
+	hv_store(client, "server", 6, 
+		newSVpv(u->uplink->name, strlen(u->uplink->name)), 0);
 	hv_store(client, "is_away", 7, 
 		newSViv(u->user->is_away), 0);
 	hv_store(client, "umodes", 6, 
@@ -333,6 +336,57 @@
 	return (client);
 }
 
+/* encode a Server Structure into a perl Hash */
+HV *perl_encode_server(Client *u) {
+	HV *client;
+	
+	client = newHV();
+	
+	hv_store(client, "name", 4, 
+		newSVpv(u->name, strlen(u->name)), 0);
+	hv_store(client, "uplink", 6, 
+		newSVpv(u->uplinkname, strlen(u->uplinkname)), 0);
+	hv_store(client, "users", 5, 
+		newSViv(u->server->users), 0);
+	hv_store(client, "awaycount", 9, 
+		newSViv(u->server->awaycount), 0);
+	hv_store(client, "hops", 4, 
+		newSViv(u->server->hops), 0);
+	hv_store(client, "ping", 4, 
+		newSViv(u->server->ping), 0);
+	hv_store(client, "uptime", 6, 
+		newSViv(u->server->uptime), 0);
+	return (client);
+}
+
+/* encode a Client Structure into a perl Hash */
+HV *perl_encode_channel(Channel *c) {
+	HV *client;
+	
+	client = newHV();
+	
+	hv_store(client, "name", 4, 
+		newSVpv(c->name, strlen(c->name)), 0);
+	hv_store(client, "topic", 5, 
+		newSVpv(c->topic, strlen(c->topic)), 0);
+	hv_store(client, "topicowner", 10, 
+		newSVpv(c->topicowner, strlen(c->topicowner)), 0);
+	hv_store(client, "topictime", 9, 
+		newSViv(c->topictime), 0);
+	hv_store(client, "users", 5, 
+		newSViv(c->users), 0);
+	hv_store(client, "modes", 5, 
+		newSViv(c->modes), 0);
+	hv_store(client, "limit", 5, 
+		newSViv(c->limit), 0);
+	hv_store(client, "key", 3, 
+		newSVpv(c->key, strlen(c->key)), 0);
+	hv_store(client, "createtime", 10, 
+		newSViv(c->creationtime), 0);
+	/* XXX todo: Encode Mode Params */
+	return (client);
+}
+
 
 
 /* NeoStats::Internal::register (scriptname, version, desc)
@@ -550,6 +604,69 @@
 	}
 }
 
+static
+XS (XS_NeoStats_FindServer)
+{
+	Module *mod;
+	Client *u;
+	SV *client;
+
+	dXSARGS;
+
+	if (items != 1) {
+		nlog(LOG_WARNING, "Usage: NeoStats::Internal::FindServer(name)");
+	} else {
+		SP -= items; /* remove args from the stack */
+		mod = GET_CUR_MODULE();
+		if (!mod) {
+			nlog(LOG_WARNING, "Current Mod Stack for Perl Mods is screwed");
+			XSRETURN_EMPTY;
+		}
+		u = FindServer(SvPV_nolen(ST(0)));
+		if (!u) {
+			XSRETURN_EMPTY;
+		}
+		/* create a hash with the users details filled in */
+		client = (SV *)perl_encode_server(u);
+		sv_2mortal(client);
+		XPUSHs(newRV_noinc((SV *)client));
+		PUTBACK;
+		XSRETURN(1);
+	}
+}
+
+
+static
+XS (XS_NeoStats_FindChannel)
+{
+	Module *mod;
+	Channel *c;
+	SV *client;
+
+	dXSARGS;
+
+	if (items != 1) {
+		nlog(LOG_WARNING, "Usage: NeoStats::Internal::FindServer(name)");
+	} else {
+		SP -= items; /* remove args from the stack */
+		mod = GET_CUR_MODULE();
+		if (!mod) {
+			nlog(LOG_WARNING, "Current Mod Stack for Perl Mods is screwed");
+			XSRETURN_EMPTY;
+		}
+		c = FindChannel(SvPV_nolen(ST(0)));
+		if (!c) {
+			XSRETURN_EMPTY;
+		}
+		/* create a hash with the users details filled in */
+		client = (SV *)perl_encode_channel(c);
+		sv_2mortal(client);
+		XPUSHs(newRV_noinc((SV *)client));
+		PUTBACK;
+		XSRETURN(1);
+	}
+}
+
 #if 0
 
 static
@@ -669,6 +786,8 @@
 	newXS ("NeoStats::Internal::AddBot", XS_NeoStats_AddBot, __FILE__);
 	newXS ("NeoStats::Internal::DelBot", XS_NeoStats_DelBot, __FILE__);
 	newXS ("NeoStats::Internal::FindUser", XS_NeoStats_FindUser, __FILE__);
+	newXS ("NeoStats::Internal::FindServer", XS_NeoStats_FindServer, __FILE__);
+	newXS ("NeoStats::Internal::FindChannel", XS_NeoStats_FindChannel, __FILE__);
 
 	stash = get_hv ("NeoStats::", TRUE);
 	if (stash == NULL) {