contrib/dbus/SipeHelper.pm

   1 #!/usr/bin/perl -w
   2 #
   3 # @file SipeHelper.pm
   4 #
   5 # pidgin-sipe
   6 #
   7 # Copyright (C) 2017 SIPE Project <http://sipe.sourceforge.net/>
   8 #
   9 # This program is free software; you can redistribute it and/or modify
  10 # it under the terms of the GNU General Public License as published by
  11 # the Free Software Foundation; either version 2 of the License, or
  12 # (at your option) any later version.
  13 #
  14 # This program is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 # GNU General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU General Public License
  20 # along with this program; if not, write to the Free Software
  21 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  22 #
  23 #
  24 # Support code for D-Bus test scripts
  25 #
  26 package SipeHelper;
  27 use 5.024;
  28 use strict;
  29 use warnings;
  30
  31 use Carp;
  32 use Net::DBus;
  33
  34 # Connect to libpurple over the session bus
  35 my $purple;
  36 sub init()
  37 {
  38     eval {
  39         my $bus     = Net::DBus->session;
  40         my $service = $bus->get_service('im.pidgin.purple.PurpleService');
  41         $purple     = $service->get_object('/im/pidgin/purple/PurpleObject',
  42                                            'im.pidgin.purple.PurpleInterface');
  43     };
  44     die "ERROR: can't find any active libpurple D-Bus instance, Are you sure you started Pidgin/Finch?\n\n$@"
  45         if $@;
  46 }
  47
  48 # Call code reference for all active SIPE accounts
  49 sub forSipeAccounts($)
  50 {
  51     my($code) = @_;
  52     croak "ERROR: ${code} should be code reference"
  53         unless ref($code) eq "CODE";
  54     croak "ERROR: called without initializing"
  55         unless $purple;
  56
  57     # Get list of enabled accounts
  58     my $accounts = $purple->PurpleAccountsGetAllActive();
  59     for my $accountId (@{ $accounts }) {
  60         my $username     = $purple->PurpleAccountGetUsername($accountId);
  61         my $protocolId   = $purple->PurpleAccountGetProtocolId($accountId);
  62         my $protocolName = $purple->PurpleAccountGetProtocolName($accountId);
  63         my $connectionId = $purple->PurpleAccountGetConnection($accountId);
  64         print "found account ${accountId}: ${username} (${protocolId}/${protocolName}, ${connectionId})\n";
  65
  66         # Filter out SIPE accounts that are online
  67         if (($protocolId eq 'prpl-sipe') && ($connectionId != 0)) {
  68
  69             # Filter out SIPE accounts that are really connected
  70             if ($purple->PurpleConnectionIsConnected($connectionId)) {
  71
  72                 # Call code reference
  73                 $code->($purple, $accountId, $username);
  74             }
  75         }
  76     }
  77 }
  78
  79 # modules need to return a true value
  80 1;