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
14use strict;
15use 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
27Irssi::settings_add_bool('PGGB', 'SOUND_autosend',	1);
28Irssi::settings_add_bool('PGGB', 'SOUND_autoget',	0);
29Irssi::settings_add_bool('PGGB', 'SOUND_play',		1);
30Irssi::settings_add_int( 'PGGB', 'SOUND_display',	5);
31Irssi::settings_add_str( 'PGGB', 'SOUND_hilight',	'(none)');
32Irssi::settings_add_str( 'PGGB', 'SOUND_DCC',		'(none)');
33Irssi::settings_add_str( 'PGGB', 'SOUND_dir',		'~/.irssi/');
34Irssi::settings_add_str( 'PGGB', 'SOUND_command',	'play');
35my $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'.
41my $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
51use File::Listing;
52use File::Basename;
53
54Irssi::command_bind("sound", "sound_command");
55Irssi::signal_add_last("complete word", "sound_complete");
56Irssi::signal_add("event privmsg", "sound_autosend");
57Irssi::signal_add("ctcp msg", "CTCP_sound");
58Irssi::signal_add('print text', 'hilight_sound');
59Irssi::signal_add('dcc created', 'DCC_sound');
60#IRC::add_message_handler("PRIVMSG", "sound_autoget");
61
62
63Irssi::theme_register([
64		       'ctcp', '{ctcp {hilight $0} $1}'
65		      ]);
66
67sub 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
74sub 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
99sub 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
110sub onoff { shift(@_) ? return "ON" : return "OFF"; }
111
112sub 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
137sub 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
148sub 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
166sub 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
176sub 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
185sub play_wave {
186  my $wave = shift(@_);
187  my $sndcmd = Irssi::settings_get_str("SOUND_command");
188  if (-r "$wave") {
189    system("$sndcmd \"$wave\" &");}}
190
191sub 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
218sub 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}
252