html/pggb_sound.pl
1 ## This is the IRSSI-version!
2 ## OK, here we go.
3 ## For bugs/suggestions/help contact me at duck@cs.uni-frankfurt.de
4 ##
5 ## This script does nothing usefull but is extremely usefull to me ;-).
6 ## It should handle CTCP SOUNDs correctly - even if the waves are stored
7 ## in subdirs and/or on SMB shares.
8 ## It can also initiate CTCP SOUNDs, handle sound requests and request
9 ## waves automatically.
10 ##
11 ## This is my first perl script. Please be kind to me ;-).
12 ## I built it on top of someone else's work, but I don't know whom...
13
14 use strict;
15 use vars qw($VERSION %IRSSI);
16
17 $VERSION = "0.2.3.23b";
18 %IRSSI = (
19 authors => 'Adam Duck',
20 contact => 'duck@cs.uni-frankfurt.de',
21 name => 'PGGB_sound',
22 description => 'does CTCP SOUNDs and other similar things.',
23 license => 'GPLv2',
24 url => '',
25 );
26
27 Irssi::settings_add_bool('PGGB', 'SOUND_autosend', 1);
28 Irssi::settings_add_bool('PGGB', 'SOUND_autoget', 0);
29 Irssi::settings_add_bool('PGGB', 'SOUND_play', 1);
30 Irssi::settings_add_int( 'PGGB', 'SOUND_display', 5);
31 Irssi::settings_add_str( 'PGGB', 'SOUND_hilight', '(none)');
32 Irssi::settings_add_str( 'PGGB', 'SOUND_DCC', '(none)');
33 Irssi::settings_add_str( 'PGGB', 'SOUND_dir', '~/.irssi/');
34 Irssi::settings_add_str( 'PGGB', 'SOUND_command', 'play');
35 my $autoget = Irssi::settings_get_bool("SOUND_autoget");
36
37 # You can use <nothing>, ".gz" or ".bz2" as extension, the script will
38 # honour it accordingly. I chose ".gz" because it should be available
39 # on most systems ...
40 # Btw, this is NOT the time consuming part. It's `parse_dir'.
41 my $cachefile = $ENV{HOME} . "/.irssi/wavdir.cache.gz";
42
43 ########################################
44 # Changelog
45 # Sat 23 Mar 2002, 12:26:39 fixed stupid bug in sound_autosend
46 #
47 # ------------------------------------------------------------
48 # Don't edit below this line unless you are prepared to code!
49 # ------------------------------------------------------------
50
51 use File::Listing;
52 use File::Basename;
53
54 Irssi::command_bind("sound", "sound_command");
55 Irssi::signal_add_last("complete word", "sound_complete");
56 Irssi::signal_add("event privmsg", "sound_autosend");
57 Irssi::signal_add("ctcp msg", "CTCP_sound");
58 Irssi::signal_add('print text', 'hilight_sound');
59 Irssi::signal_add('dcc created', 'DCC_sound');
60 #IRC::add_message_handler("PRIVMSG", "sound_autoget");
61
62
63 Irssi::theme_register([
64 'ctcp', '{ctcp {hilight $0} $1}'
65 ]);
66
67 sub help {
68 Irssi::print("USAGE: /sound setup|<somewav>(.wav)?");
69 Irssi::print("\nsetup: creates the (vital) cache file.");
70 Irssi::print("Please setup all variables through the /SET command (they all begin with \"SOUND_\").");
71 Irssi::print("\nIf you have copied new waves to your sounddir, be sure to run \"/sound setup\" again!");
72 }
73
74 sub find_wave {
75 unless ( -e "$cachefile" ) {
76 Irssi::print("Cache file not found...");
77 create_cache();}
78 my $sound = shift(@_);
79 unless ($sound =~ /^.*\.wav$/i) {$sound = $sound . ".*.wav"}
80 my $LISTING;
81 if ( -r $cachefile ) {
82 if ($cachefile =~ /\.gz$/i) { open(LISTING, "zcat $cachefile |") }
83 elsif ($cachefile =~ /\.bz2$/i) { open(LISTING, "bzcat $cachefile |") }
84 else { open(LISTING, "cat $cachefile |") };
85 } else {
86 Irssi::print("Cache file not readable. Nani?!?");
87 return;}
88 my @dir = parse_dir(\*LISTING, '+0001');
89 close(LISTING);
90 my $result = [];
91 for (@dir) {
92 my ($fName, $fType, $fSize, $fMtime, $fMode) = @$_;
93 if (basename($fName) =~ /^$sound$/i) {
94 #Irssi::print "$fName, $fType, $fSize, $fMtime, $fMode";
95 push @$result, $fName;}}
96 return @$result;
97 }
98
99 sub create_cache {
100 my $sounddir = Irssi::settings_get_str("SOUND_dir") . "/";
101 # we need the "LC_CTYPE=en" here because dir_parse is unable
102 # to parse things like "Mär 3" (German locale) ...
103 Irssi::print("Creating $cachefile (this could take a while...)");
104 my $command = "/exec LC_CTYPE=en ls -lR $sounddir";
105 if ($cachefile =~ /\.gz$/i) { $command = $command . " | gzip" }
106 elsif ($cachefile =~ /\.bz2$/i) { $command = $command . " | bzip2" }
107 Irssi::command("$command > $cachefile");
108 }
109
110 sub onoff { shift(@_) ? return "ON" : return "OFF"; }
111
112 sub sound_command {
113 my $sounddir = Irssi::settings_get_str("SOUND_dir") . "/";
114 my $soundcmd = Irssi::settings_get_str("SOUND_command");
115
116 my ($data, $server, $witem) = @_;
117 $data =~ /([\w\.]+)(.*)/;
118 my $sound = $1;
119 my $rest = $2;
120 $rest =~ s/ *//;
121 unless ($rest eq "") { $rest = " " . $rest;};
122 if ($sound =~ /^setup$/i) { create_cache(); return; }
123 if (!($sound =~ /.*\.wav/i)) { $sound = $sound . ".wav";}
124 if ($witem && ($witem->{type} eq "CHANNEL" ||
125 $witem->{type} eq "QUERY")) {
126 my $wavefile = (find_wave($sound))[0];
127 if ( -r $wavefile ) {
128 $witem->command("/CTCP $witem->{name} SOUND ".lc(basename($wavefile))."$rest");
129 my $playcmd = system("$soundcmd $wavefile &"); # that's not so good ...
130 } else {
131 $witem->print("\"$sound\" not found in \"$sounddir\" or cache file too old."); }
132 } else {
133 Irssi::print "There's no point in running a \"CTCP SOUND\" command here."; }
134 return 1;
135 }
136
137 sub sound_complete {
138 my ($complist, $window, $word, $linestart, $want_space) = @_;
139 if ($linestart =~ /^\/sound$/) {
140 my $coli = [];
141 for (find_wave($word)) { push(@$coli, basename($_)); }
142 my $max = Irssi::settings_get_int('SOUND_display');
143 if (@$coli > $max) {
144 $window->print("@$coli[0..($max-1)] ...");
145 } else {
146 push @$complist, @$coli; }}}
147
148 sub sound_autosend {
149 if (!Irssi::settings_get_bool("SOUND_autosend")) { return 0; }
150 my ($server, $data, $nick, $address) = @_;
151 my $myname = $server->{nick};
152
153 $data =~ /(.*) :!$myname +(.*\.wav)/i;
154 if ($2 eq "") { return 0; }
155 my $channel = $1;
156 my $wavefile = (find_wave($2))[0];
157 if ($wavefile ne "") {
158 Irssi::print("DCC sending $wavefile to $nick");
159 $server->command("/DCC SEND $nick $wavefile");
160 } else {
161 $server->send_message($nick, "Sorry, $nick. $2 not found.", 1);
162 }
163 return 1;
164 }
165
166 sub hilight_sound {
167 my ($dest, $text, $stripped) = @_;
168 my $server = $dest->{server};
169 unless ($server->{usermode_away}) {
170 my $hiwave = Irssi::settings_get_str('SOUND_hilight');
171 if (($hiwave ne '(none)') &&
172 ($dest->{level} & (MSGLEVEL_HILIGHT|MSGLEVEL_MSGS)) &&
173 ($dest->{level} & MSGLEVEL_NOHILIGHT) == 0) {
174 play_wave(find_wave($hiwave));}}}
175
176 sub DCC_sound {
177 my $dcc = shift(@_);
178 my $server = $dcc->{server};
179 Irssi::print("$dcc->{type}");
180 unless ($server->{usermode_away} || ($dcc->{type} eq "SEND")) {
181 my $hiwave = Irssi::settings_get_str('SOUND_DCC');
182 if ($hiwave ne '(none)') {
183 play_wave(find_wave($hiwave));}}}
184
185 sub play_wave {
186 my $wave = shift(@_);
187 my $sndcmd = Irssi::settings_get_str("SOUND_command");
188 if (-r "$wave") {
189 system("$sndcmd \"$wave\" &");}}
190
191 sub sound_autoget {
192 if (!$autoget) { return 0; }
193 my $sounddir = Irssi::settings_get_str("SOUND_dir") . "/";
194
195 my $line = shift (@_);
196 #:nick!host PRIVMSG channel :message
197 $line =~ /:(.*)!(\S+) PRIVMSG (.*) :(.*)/i;
198
199 my $name = $1;
200 my $channel = $3;
201 my $text = $4;
202 my $name = "$name";
203 my @wordlist = split(' ',$4);
204
205 if ($wordlist[0] eq "\001SOUND") {
206 my $tempsound = $wordlist[1];
207 $tempsound =~ s/[\r \001 \n]//;
208 IRC::print($tempsound);
209 if (!open(TEMPFILE, $sounddir.$tempsound)) {
210 IRC::send_raw("PRIVMSG $name :!$name $tempsound\r\n");
211 } else {
212 close(TEMPFILE);
213 }
214 }
215 return 0;
216 }
217
218 sub CTCP_sound {
219 my $play = Irssi::settings_get_bool("SOUND_play");
220 my $soundcmd = Irssi::settings_get_str("SOUND_command");
221
222 my ($server, $args, $nick, $addr, $target) = @_;
223 $args =~ /^SOUND (.*\.wav)(.*)$/i;
224 if ($1 eq "") { return 0; }
225
226 my $sound = $1;
227 my $wavfile = (find_wave($1))[0];
228 my $output = "";
229 my $rest = $2;
230 $rest =~ s/^ *//;
231 if ( $rest ne "" ) { # this one is for P&P & co.
232 $output = $output . $rest
233 } else {
234 $output = $output . " plays $sound";
235 }
236 if ($wavfile eq "") {
237 $output = $output . " (not found)";
238 if ($autoget) {
239 Irssi::send_raw("PRIVMSG $nick :!$nick $sound\r\n");
240 }
241 } else {
242 if ($play) {
243 system("$soundcmd \"$wavfile\" &");
244 } else {
245 $output = $output . " (muted)";
246 }
247 }
248 my $wItem = $server->window_find_item($target);
249 $wItem->printformat(MSGLEVEL_CTCPS, 'ctcp', $nick, $output);
250 Irssi::signal_stop();
251 }