tools/login.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5 use lib q(perl/lib);
   6 use THPPW;
   7 use Glib qw(G_PRIORITY_DEFAULT);
   8
   9 my $loop = Glib::MainLoop->new();
  10 my $DEBUG = 0;
  11
  12 my $user  = shift;
  13 my $pass  = shift;
  14 my $proto = shift;
  15 my $debug = shift || 0;
  16
  17 # Simple error handling
  18 if (!$user or !$pass or !$proto) {
  19     print "Syntax: $0 username password protocol\n";
  20     exit 0;
  21 }
  22
  23
  24 # Initialize the wrapper
  25 # Do this BEFORE initializing the libpurple internals!
  26 THPPW::thrasher_wrapper_init(\&timeout_add,
  27                              \&input_add,
  28                              \&source_remove,
  29                              \&incoming_msg,
  30                              \&presence_in,
  31                              \&subscription_add,
  32                              \&connection_error);
  33
  34 THPPW::thrasher_purple_debug($debug);
  35
  36 # Initialize the beast
  37 THPPW::thrasher_init();
  38
  39 # Login
  40 THPPW::thrasher_action_login('n/a', $user, $pass, $proto);
  41
  42 # Let the eventloop fly!
  43 $loop->run();
  44
  45
  46 # Thrasher Bird subrefs
  47 sub incoming_msg {
  48 }
  49
  50 sub presence_in {
  51 }
  52
  53 sub subscription_add {
  54 }
  55
  56 sub connection_error {
  57 }
  58
  59
  60
  61 # Subrefs for which to satiate the libpurple monster
  62 sub timeout_add {
  63     my $interval = shift;
  64     my $code     = shift;
  65     my $trigger  = shift;
  66
  67     debug_out("perl::timeout_add called\n");
  68
  69     debug_out("\tinterval = $interval\n") if $interval;
  70     debug_out("\tcode     = $code\n")     if $code;
  71     debug_out("\ttrigger  = $trigger\n")  if $trigger;
  72
  73     my $ret =Glib::Timeout->add($interval,
  74                              ($code, $trigger),
  75                              G_PRIORITY_DEFAULT);
  76
  77     debug_out("Glib::Timeout->add returned [$ret]\n");
  78     return $ret;
  79 };
  80
  81
  82 sub source_remove {
  83     debug_out("perl::timeout_remove called with $_[0]\n");
  84
  85     return Glib::Source->remove($_[0]);
  86     return 1;
  87 }
  88
  89 sub input_add {
  90     my $fd       = shift;
  91     my $cond     = shift;
  92     my $code     = shift;
  93     my $trigger  = shift;
  94
  95     my $i = 0;
  96     foreach (@_) {
  97         debug_out("\t$i = $_\n");
  98         $i++;
  99     }
 100
 101
 102     debug_out("\tfd       = $fd\n")      if $fd;
 103     debug_out("\tcond     = $cond\n")    if $cond;
 104     debug_out("\tcode     = $code\n")    if $code;
 105     debug_out("\ttrigger  = $trigger\n") if $trigger;
 106
 107     $cond = ($cond == 1) ? 'G_IO_IN' : 'G_IO_OUT';
 108
 109     my $ret = Glib::IO->add_watch($fd,
 110                                   $cond,
 111                                   $code,
 112                                   $trigger,
 113                                   G_PRIORITY_DEFAULT);
 114
 115     debug_out("Glib::IO->add_watch returned [$ret]\n");
 116
 117     return $ret;
 118 }
 119
 120
 121 sub debug_out {
 122     my $msg = shift;
 123
 124     if ($DEBUG) {
 125         print $msg;
 126     }
 127 }