Mercurial > pidgin.yaz
annotate libpurple/plugins/perl/scripts/signals-test.pl @ 32827:4a34689eeb33 default tip
merged from im.pidgin.pidgin
author | Yoshiki Yazawa <yaz@honeyplanet.jp> |
---|---|
date | Sat, 19 Nov 2011 14:42:54 +0900 |
parents | ae1c7756f1bd |
children |
rev | line source |
---|---|
17114
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.", |
18282
0fb8f1b1f0e9
sadrul can't spell "use".
Will Thompson <will.thompson@collabora.co.uk>
parents:
17114
diff
changeset
|
10 description => "Demonstrate the use of purple signals from " . |
17114
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 |
29792
ae1c7756f1bd
Add timeout_add() example to the Perl signals-test plugin
Daniel Atallah <daniel.atallah@gmail.com>
parents:
18282
diff
changeset
|
47 sub timeout_cb |
ae1c7756f1bd
Add timeout_add() example to the Perl signals-test plugin
Daniel Atallah <daniel.atallah@gmail.com>
parents:
18282
diff
changeset
|
48 { |
ae1c7756f1bd
Add timeout_add() example to the Perl signals-test plugin
Daniel Atallah <daniel.atallah@gmail.com>
parents:
18282
diff
changeset
|
49 Purple::Debug::misc("signals test in perl", "timeout elapsed\n"); |
ae1c7756f1bd
Add timeout_add() example to the Perl signals-test plugin
Daniel Atallah <daniel.atallah@gmail.com>
parents:
18282
diff
changeset
|
50 } |
ae1c7756f1bd
Add timeout_add() example to the Perl signals-test plugin
Daniel Atallah <daniel.atallah@gmail.com>
parents:
18282
diff
changeset
|
51 |
17114
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
52 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
|
53 { |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
54 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
|
55 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
56 # 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
|
57 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
58 # Accounts |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
59 $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
|
60 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
|
61 \&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
|
62 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
63 # Buddy List |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
64 $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
|
65 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
|
66 \&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
|
67 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
68 # Connections |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
69 $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
|
70 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
|
71 \&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
|
72 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
73 # Conversations |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
74 $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
|
75 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
|
76 \&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
|
77 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
|
78 \&conv_received_msg, "received chat message"); |
29792
ae1c7756f1bd
Add timeout_add() example to the Perl signals-test plugin
Daniel Atallah <daniel.atallah@gmail.com>
parents:
18282
diff
changeset
|
79 |
ae1c7756f1bd
Add timeout_add() example to the Perl signals-test plugin
Daniel Atallah <daniel.atallah@gmail.com>
parents:
18282
diff
changeset
|
80 |
ae1c7756f1bd
Add timeout_add() example to the Perl signals-test plugin
Daniel Atallah <daniel.atallah@gmail.com>
parents:
18282
diff
changeset
|
81 Purple::timeout_add($plugin, 10, \&timeout_cb); |
17114
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
82 } |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
83 |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
84 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
|
85 { |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
86 # 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
|
87 } |
dae18f23a09d
A signals-test plugin for perl. This should help plugin developers get
Sadrul Habib Chowdhury <imadil@gmail.com>
parents:
diff
changeset
|
88 |