SkypeAPI.pm

   1 #!/usr/bin/perl -w
   2
   3 # This is a very basic example on how to use the Skype API via DBus using perl.
   4 # Written by jlh at gmx dot ch.  I declare this to be public domain, use it for
   5 # whatever you like.
   6
   7 # This requires the module Net::DBus to be installed.
   8
   9 use strict;
  10 use warnings;
  11
  12 package SkypeAPI; # -----------------------------------------------------------
  13
  14 # We need two objects to communicate with Skype, one for the client -> Skype
  15 # direction, and one for Skype -> client direction.  This class (SkypeAPI)
  16 # inherits from Net::DBus::Object and represents the DBus /com/Skype/Client
  17 # object that Skype uses to notify us about events (by calling its Notify
  18 # method).  The other object, which is Skype's /com/Skype object, is held in
  19 # $self->{invoker}; we call its Invoke method to tell Skype our commands.
  20
  21 # This class by itself only does the handshake with Skype and then merely
  22 # prints all notifications it receives to the terminal.  If you want to do
  23 # something useful, then you have to subclass this and override the Notify
  24 # method to do whatever you want.  We do this as an example with the Example
  25 # class further down.
  26
  27 use base 'Net::DBus::Object';
  28 use Net::DBus;
  29
  30 sub new {
  31         my ($class, $name) = @_;
  32
  33         my $bus = Net::DBus->session;
  34
  35         # export a service and the object /com/Skype/Client, so Skype can
  36         # invoke the 'Notify' method on it in order to communicate with us.
  37         my $exp_service = $bus->export_service("com.Skype.API") or die;
  38         my $self = $class->SUPER::new($exp_service, '/com/Skype/Client') or die;
  39         bless $self, $class;
  40
  41         # get a handle to Skype's /com/Skype object, so we can invoke the
  42         # 'Invoke' method on it to communicate with Skype.
  43         my $service = $bus->get_service("com.Skype.API") or die;
  44         $self->{invoker} = $service->get_object("/com/Skype") or die;
  45
  46         # setup is done, let's shake hands
  47         my $r = $self->Invoke("NAME $name");
  48         die "Handshake failed: $r" unless $r eq 'OK';
  49         $r = $self->Invoke("PROTOCOL 5");
  50         die "Handshake failed: $r" unless $r eq 'PROTOCOL 5';
  51
  52         return $self;
  53 }
  54
  55 sub Notify {
  56         # only print to terminal.  override this in a subclass for something
  57         # more useful.
  58         my ($self, $string) = @_;
  59         print "Notify <- $string\n";
  60         if ( $string =~ m{CHATMESSAGE (\d+) STATUS RECEIVED} ) {
  61                 my $id = $1;
  62                 my $body = $self->Invoke("GET CHATMESSAGE $id BODY");
  63                 print "# $body\n";
  64                 my $chat = $self->Invoke("GET CHATMESSAGE $id CHATNAME");
  65                 my $o = $self->Invoke($body);
  66                 print "# $o\n";
  67                 $self->Invoke("CHATMESSAGE $chat $o");
  68         }
  69
  70         # be careful with what you return here!  DBus will try to serialize it,
  71         # returning it to skype.  you should explicitely return something
  72         # simple to avoid to leak something unserializable, causing odd errors.
  73         return 0;
  74 }
  75
  76 sub Invoke {
  77         # this doesn't print $string, so that subclasses can call it without
  78         # that side effect.  subclass it yourself if you want it to do that.
  79         my ($self, $string) = @_;
  80         print "Invoke -> $string\n";
  81         my $response = $self->{invoker}->Invoke($string);
  82         print "Invoke <- $response\n";
  83         if ( $string =~ s/^get //i ) {
  84                 $response =~ s/^\Q$string\E *//;
  85         }
  86         return $response;
  87 }
  88
  89 package Example; # ------------------------------------------------------------
  90
  91 # This Example class inherits from SkypeAPI and does something very simple:
  92 # Whenever you go into away-mode, it will put you in not-available-mode
  93 # instead.  That's not very useful, but it's just an example.  This is where
  94 # you would implement your interesting stuff and/or write a nicer wrapper
  95 # around the whole Skype API.
  96
  97 use base 'SkypeAPI';
  98
  99 sub Notify {
 100         my ($self, $string) = @_;
 101
 102         # call the parent's Notify method, so it still prints to the terminal.
 103         $self->SUPER::Notify($string);
 104
 105         if ($string eq 'USERSTATUS AWAY') {
 106                 # away mode is no good!  let's be not available
 107                 $self->Invoke('SET USERSTATUS NA');
 108         }
 109         return 0;
 110 }
 111
 112 package main; # ---------------------------------------------------------------
 113
 114 use Net::DBus::Reactor;
 115
 116 my $skype = Example->new('Example');
 117
 118 # Run main event loop, the $skype instance has automatically been attached to
 119 # it (it's a singleton).  See the documentation for Net::DBus::Reactor to learn
 120 # how to attach more stuff to this loop, like file handles or timer events.
 121 my $reactor = Net::DBus::Reactor->main;
 122 $reactor->run;
 123
 124 # end of file