Page 2 of 2 FirstFirst 12
Results 11 to 13 of 13

Thread: newbie perl question using Net::OSCAR module

  1. #11

    Re:newbie perl question using Net::OSCAR module

    Try having it print out information as it runs. For instance, have it print out all the input it recives and where it is in the code. That should help debug.

  2. #12

    Re:newbie perl question using Net::OSCAR module

    sorry I'm so late in a reply, but i got everything working ;D, here's the code , i will add more features later, after i get a nice server box going i may release it as some sort of project, but i definatley need to add more features first...
    special thanks to ashcrow and gorn, for basically teaching/telling me how to do everything...
    Code:
     #!/usr/bin/perl -w 
    use PHP::Strings;
    use Net::OSCAR qw(:standard);
    
    # Set configuration params --------------------------------
    %users = ('allowed_user' => 1, 'unauthorized' => 0);
    $aim = Net::OSCAR->new();
    $aim->set_callback_im_in(\&im_in);
    $aim->set_callback_evil(\&evil);
    $aim->set_callback_signon_done(\&signon_done);
    $aim->signon(screenname => "sn", password => "passwd", OSCAR_SVC_AIM);
    $aim->set_visibility(VISMODE_PERMITALL);
    # ------------------------------------------------------------
    
    # Main Loop
    while(1) {
      $aim->do_one_loop();
    }
    
    sub signon_done {
    my ($aim) = @_;
    $aim->commit_buddylist;
    print "signed on\n";
    return;
    }
    
    # When an IM comes in do the following ...
    sub im_in {
     my ($aim, $from, $msg, $away) = @_;
      print "message recieved\n"; 
      $from = lc($from);
      $from =~ s/ //g;
      $msg  =~ s/<.*?>//g;
      $log = "$from: $msg\n";
      print $log;
      open LOG, ">>log";
      print LOG "$log";
      close LOG;
      if (!$users{$from}) {
       print "$from didn't get authed\n";
        return;
      } else {
        print "$from got authed\n";
      @command = split(/ /, $msg);
         if ($command[0] eq "!warn") {
            $victim = $command[1];
            $aim->evil($victim);
    $aim->send_im($from, "$victim warned");
            return;
          }
          if ($command[0] eq "!dc") { 
    $aim->send_im($from, "disconnecting");
    $aim->signoff;
    exit;
              }
          }
          if ($command[0] eq "hello") {
    $aim->send_im($from, "hello");
            return; 
      }
     } 
    #}
    
    # If someone 'warns' the bot then ...
    sub evil {
      my ($aim, $new, $from) = @_;
      $aim->send_im($from, "don't warn me");
        $aim->evil($from);
        $aim->evil($from);
        $aim->evil($from);
        $aim->evil($from);
        $aim->evil($from);
    }

  3. #13

    Re:newbie perl question using Net::OSCAR module

    now i'm attempting to implement a mail command, which is similar to gaim's buddy pounce
    the messages never get sent, even if the buddy is on at the time i run the
    mail $user $message
    command, but it does stay in the queue file
    here's all my changes (regarding mail) from last post
    Code:
    use Tie::File;
    
    # Main Loop
    while(1) {
      $aim->do_one_loop();
      $date = `/bin/date`;
      send_mail();
    }
    
    sub send_mail() {
     tie @queue, 'Tie::File', 'queue';
    #count lines
     $x = 0;
      open FILE, "queue";
      while (sysread FILE, $buffer, 4096) {
       $x += ($buffer =~ tr/\n//);
     }
     close FILE;
    #go through file and send all queued mails, if users are signed on
     for(; $x > 0; $x--) {
     @content = split(/ /,$queue[$x]);
     $from = $content[0];
     $to = $content[1];
     $content[1] = "sent:";
     $msg = join(' ',@content);
     if ($aim->is_on($to) == "true") {
       $aim->send_im($to, "$msg");
       $aim->send_im($from, "mail for $to sent");
       delete $queue[$x];
      }
     }
    }
    thanks, and if you need more explanation of the code (my commenting is horrible) please let me know..
    thanks

Similar Threads

  1. Perl module problem
    By Outlaw in forum Linux - Software, Applications & Programming
    Replies: 3
    Last Post: 05-04-2005, 02:17 PM
  2. Some Perl Questions, File::Find Module
    By shebang in forum Linux - Software, Applications & Programming
    Replies: 18
    Last Post: 04-03-2004, 07:25 PM
  3. perl question from a perl newb
    By tolstoy in forum Linux - Software, Applications & Programming
    Replies: 4
    Last Post: 09-06-2002, 01:16 AM
  4. MP3::Info (perl module)
    By in forum Linux - Software, Applications & Programming
    Replies: 2
    Last Post: 07-20-2002, 10:10 PM
  5. web sites for newbie Perl coders
    By cga in forum Linux - Software, Applications & Programming
    Replies: 1
    Last Post: 03-21-2002, 02:41 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •