Mercurial > pidgin
annotate libpurple/plugins/perl/scripts/signals-test.pl @ 17101:dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
an idea of how signals work in purple.
author | Sadrul Habib Chowdhury <imadil@gmail.com> |
---|---|
date | Wed, 16 May 2007 02:34:56 +0000 |
parents | |
children | 0fb8f1b1f0e9 |
rev | line source |
---|---|
17101
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
1 $MODULE_NAME = "Signals Test Script in Perl"; |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
2 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
3 use Purple; |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
4 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
5 %PLUGIN_INFO = ( |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
6 perl_api_version => 2, |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
7 name => "Perl: $MODULE_NAME", |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
8 version => "0.1", |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
9 summary => "Signals Test plugin for the Perl interpreter.", |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
10 description => "Demonstrate the user of purple signals from " . |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
11 "a perl plugin.", |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
12 author => "Sadrul Habib Chowdhury <sadrul\@pidgin.im>", |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
13 url => "http://developer.pidgin.im/wiki/sadrul/", |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
14 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
15 load => "plugin_load", |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
16 unload => "plugin_unload" |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
17 ); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
18 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
19 # Accounts |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
20 sub account_connecting_cb |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
21 { |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
22 my $account = shift; |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
23 Purple::Debug::misc("signals test in perl", "account-connecting (" . $account->get_username() . ")\n"); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
24 } |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
25 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
26 # Buddylist |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
27 sub buddy_signed_on |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
28 { |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
29 my $buddy = shift; |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
30 Purple::Debug::misc("signals test in perl", "buddy-signed-on (" . $buddy->get_name() . ")\n"); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
31 } |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
32 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
33 # Connections |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
34 sub signed_on |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
35 { |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
36 my $conn = shift; |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
37 Purple::Debug::misc("signals test in perl", "signed-on (" . $conn->get_account()->get_username() . ")\n"); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
38 } |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
39 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
40 # Conversations |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
41 sub conv_received_msg |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
42 { |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
43 my ($account, $sender, $message, $conv, $flags, $data) = @_; |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
44 Purple::Debug::misc("signals test in perl", "$data (" . $account->get_username() . ", $sender, $message, $flags)\n"); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
45 } |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
46 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
47 sub plugin_load |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
48 { |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
49 my $plugin = shift; |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
50 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
51 # Hook to the signals |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
52 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
53 # Accounts |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
54 $act_handle = Purple::Accounts::get_handle(); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
55 Purple::Signal::connect($act_handle, "account-connecting", $plugin, |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
56 \&account_connecting_cb, 0); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
57 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
58 # Buddy List |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
59 $blist = Purple::BuddyList::get_handle(); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
60 Purple::Signal::connect($blist, "buddy-signed-on", $plugin, |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
61 \&buddy_signed_on, 0); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
62 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
63 # Connections |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
64 $conn = Purple::Connections::get_handle(); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
65 Purple::Signal::connect($conn, "signed-on", $plugin, |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
66 \&signed_on, 0); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
67 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
68 # Conversations |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
69 $conv = Purple::Conversations::get_handle(); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
70 Purple::Signal::connect($conv, "received-im-msg", $plugin, |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
71 \&conv_received_msg, "received im message"); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
72 Purple::Signal::connect($conv, "received-chat-msg", $plugin, |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
73 \&conv_received_msg, "received chat message"); |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
74 } |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
75 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
76 sub plugin_unload |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
77 { |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
78 # Nothing to do here for this plugin. |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
79 } |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
80 |