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
7 # This requires the module Net::DBus to be installed.
12 package SkypeAPI; # -----------------------------------------------------------
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.
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
27 use base 'Net::DBus::Object';
31 my ($class, $name) = @_;
33 my $bus = Net::DBus->session;
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;
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;
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';
56 # only print to terminal. override this in a subclass for something
58 my ($self, $string) = @_;
59 print "Notify <- $string\n";
60 if ( $string =~ m{CHATMESSAGE (\d+) STATUS RECEIVED} ) {
62 my $body = $self->Invoke("GET CHATMESSAGE $id BODY");
64 my $chat = $self->Invoke("GET CHATMESSAGE $id CHATNAME");
65 my $o = $self->Invoke($body);
67 $self->Invoke("CHATMESSAGE $chat $o");
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.
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 *//;
89 package Example; # ------------------------------------------------------------
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.
100 my ($self, $string) = @_;
102 # call the parent's Notify method, so it still prints to the terminal.
103 $self->SUPER::Notify($string);
105 if ($string eq 'USERSTATUS AWAY') {
106 # away mode is no good! let's be not available
107 $self->Invoke('SET USERSTATUS NA');
110 if ( $string =~ m{CALL (\d+) STATUS RINGING} ) {
111 $self->Invoke("ALTER CALL $1 ANSWER");
112 } elsif ( $string =~ m{CALL (\d+) STATUS INPROGRESS} ) {
114 my $port = 5000 + $call_id;
118 tcpserversrc port=$port !
119 "audio/x-raw-int,rate=16000,width=16,channels=1" !
121 filesink location=/tmp/$port.wav
123 $gst =~ s{[\s\n\r]+}{ }gs;
126 open(my $g, '-|', $gst) || die $!;
132 $self->Invoke(qq|ALTER CALL $call_id set_output port="$port"|);
133 } elsif ( $string =~ m{CALL (\d+) STATUS FINISHED} ) {
134 my $port = $1 + 5000;
135 my $path = "/tmp/$port.wav";
136 warn "# $path ", -s $path, " bytes\n";
137 # } elsif ( $string =~ m{} ) {
143 package main; # ---------------------------------------------------------------
145 use Net::DBus::Reactor;
147 my $skype = Example->new('Example');
149 # Run main event loop, the $skype instance has automatically been attached to
150 # it (it's a singleton). See the documentation for Net::DBus::Reactor to learn
151 # how to attach more stuff to this loop, like file handles or timer events.
152 my $reactor = Net::DBus::Reactor->main;