#!/usr/bin/perl -w
$| = 1;
use strict;
# if you have the Xmms module in a custom location, note it here:
#use lib "/usr/lib/perl5/site_perl/5.8.0/i386-linux-thread-multi";
my $JAMMING = "\002now playing\002 |:.";
my $JAMMING2 = "\002\ \002";
#my $JAMMING = "is jamming"; # replace with whatever you want to say
# Change colors (or whatever) here. You can change the escape codes
# independently for the channel messages, private messages, topics and
# XChat messages (WINDOW).
#
# WARNING: XChat-XMMS sends RAW IRC code, and you can mess up your
# messages if you put newlines (\r \n) or null (\000) codes in here!
# These codes will be written over if the user uses the new /xmms color
# commands (so don't use those, if you have a custom way of doing it!)
#
# Red
#
my %COLORS =
(
CHANNEL => [ "\0035.:| ", "\003" ],
MSG => [ "\0035.:| ", "\003" ],
TOPIC => [ "\0035.:| ", "\003" ],
WINDOW => [ "\0035.:| ", "\003" ]
);
#
# No colors/ANSI crap at all; just a couple colons and a space
#
# my %COLORS =
# (
# CHANNEL => [ ":: ", "" ],
# MSG => [ ":: ", "" ],
# TOPIC => [ ":: ", "" ],
# WINDOW => [ ":: ", "" ]
# );
use Xmms ();
use Xmms::Remote ();
use IO::File;
my $VORBIS_PATH = "vorbiscomment"; # change if different on your system
my $usage =
"
XCHAT/XMMS by ink (ink\@inconnu.isu.edu)
All commands are issued like this, using /xmms as the IRC command:
/xmms [command] [arg1], [arg2], ...
But leave out the square braces []
Commands
--------
QUERIES FOR CURRENTLY PLAYING SONG & XMMS SETTINGS
query [file | song | time | version | vol] -- sends results to XMMS window
yell [query option] -- Just like query; sends results to channel
topic [query option] -- Just like query; sets the results as topic
msg [nick] [query option] -- Just like query; sends to nick
CONTROLS FOR XMMS (next song, volume, shuffle, etc.)
tell [next | pause | play | prev | repeat | shuffle | stop ]
tell [jump] [time] -- jumps to 'time' point in song; if 'time' has a
colon in it, then it jumps to minutes:seconds,
otherwise it is just the number of seconds
tell [vol] [level] -- sets volume to 'level', which must be between
0 and 100
AUTOMATIC TOPICS, CHANNEL YELLS and PRIVATE MESSAGES
auto [list] -- List all current auto topics, yells and queries
auto [query] -- Automatically sends messages when the song changes to the
\"current\" XChat window
auto [topic | yell] [#channel] -- The same as 'query', but sends the new
new song information to the channel, or
as the channel topic of '#channel'.
auto [cancel] [ see above ] -- Cancels an automatic notification
auto [delay] [number seconds] -- XChat-XMMS has a minimum delay to avoid
flooding when you're changing XMMS songs
rapidly (default 120 seconds)
SEARCHING THE CURRENT PLAYLIST
dcc [nick] [song] -- Just like play [see below] but sends 'song' to
'nick' through dcc. If more than one song matches,
no song is sent and a list of matches is presented
to you.
list [song] -- Just like play [see below] but only prints information
play [song] -- If 'song' is absent, it just toggles the play button.
If 'song' is a number, it jumps to that song in the playlist
If 'song' is a perl regular expression, it finds all the
matches based on song title and filename; if it matches
more than one song, it will list the songs and their
playlist number. Some examples:
/xmms play /smashing pumpkins/
/xmms play 342
/xmms play /.*cure\$/
if there is only one match, that song instantly starts
playing. All matches are case-insensitive.
refresh -- re-read the playlist from XMMS (needs to be done
after you change playlists)
REMOTE BROWSING / TRANSFERS
remote [enable | disable] -- enables or disables remote browsing, which
is done via /msg commands (see /xmms help remote)
send [nick] -- sends currently playing song as DCC to nick
transfers [enable | disable] -- allows others to DCC songs from you
MISCELLANEOUS FUNCTIONS
color [new color] -- tell XChat-XMMS to use a different color
language [ en ] -- switch to new locale (not implemented yet)
help [examples] -- this help screen (try \"/xmms help examples\" too!)
";
my $examples =
"XCHAT/XMMS Examples
/xmms query song - show the currently playing song on my private window
/xmms query vol - show the current volume setting on my private window
/xmms yell song - show the currently playing song to the current channel
/xmms msg jo song - show the currently playong song in a /msg to \"jo\"
/xmms play 355 - play the 355th song in my playlist
/xmms play /wake/ - play a song with \"wake\" in the title or filename
/xmms list /^a.*/ - list all songs that start with \"a\"
/xmms tell pause - pause the player
/xmms tell play - resume (/xmms play also works for this)
/xmms tell jump 0 - jump to zero seconds in the curent song (start it over)
/xmms tell vol 50 - set the volume to 50%]
/xmms list /nin.*track 5/ - list track number 5 of all 'nin' songs
/xmms dcc jo 253 - send track 253 to \"jo\" via DCC
/xmms send jo - send the currently playing song to \"jo\" via DCC
/xmms auto topic #foo - change the topic of channel #foo when song changes
/xmms auto yell #bar - annonce song changes to channel #bar
/xmms auto query - send a private message to user on song change
/xmms cancel auto topic #foo - Cancel the above auto-topic command
/xmms auto delay 600 - sets the minimum delay between autos to 10 minutes
";
my $remote_help =
"
/msg <user> xmms-request list /search/ -- accepts regular expressions
/msg <user> xmms-request list /123/ -- accepts playlist numbers
/msg <user> xmms-request list song -- shows currently playing song
/msg <user> xmms-request send 123 -- sends song number \"123\" via DCC
";
my $remote = Xmms::Remote->new;
my %playlist = undef; # global playlist for object state
############ Setup
### who-ha edit ###
IRC::register("X-Chat XMMS Script [who-ha edit]", "0.8.1", "", "");
print_window ("Loading X-Chat XMMS Script v0.8.1 [who-ha edit]");
###################
my %state; # holds all state information (private
# object vars)
$state{have_ogg} = test_vorbis(); # look for vorbiscomment
$state{have_mp3info} = test_mp3info(); # look for MP3::Info
$state{have_usleep} = test_usleep(); # look for a sleep that does better than 1 second
$state{remote_enabled} = undef; # remote playlist browsing enabled? (off by default)
$state{transfers} = undef; # remote DCC requests enabled? (off by default)
$state{send_queue} = []; # sending queue for remote listening (DCC)
$state{auto_queue} = {}; # auto queue (auto topic, auto yell, etc.)
$state{auto_queue}->{YELL} = {};
$state{auto_queue}->{TOPIC} = {};
$state{auto_queue}->{MIN_SECS} = 120; # minimum time between auto-yell and auto-topic
$state{auto_queue}->{LAST_UPDATE} = time();
# note: we need the 'queue' arrays/hashes above due to the event-driven way that
# xchat plugins work; one process will fill up a queue, and some timing
# mechanism can empty them and such
my %GENERIC_COLORS =
qw (
white 0
black 1
blue 2
green 3
red 4
brown 5
purple 6
orange 7
yellow 8
lgreen 9
teal 10
cyan 11
lblue 12
pink 13
grey 14
silver 15
);
### who-ha edit ###
xmms_color("blue");
xmms_auto("yell", "*");
xmms_auto("delay", "1");
xmms_refresh();
###################
print_window("For help: /xmms help");
############ Callback Registration (try to keep to a minimum, so we don't pollute XChat)
IRC::add_command_handler("xmms", "xmms_handler");
IRC::add_message_handler("PRIVMSG", "xmms_privmsg");
IRC::add_timeout_handler(5000, "xmms_auto_work");
############ Main handler
sub xmms_handler {
my $line = shift(@_);
my @tokens = split (/\s+/, $line);
my $command = shift(@tokens);
# check to see that XMMS is actually running
unless (are_attached()) {
return 1;
}
# make sure playlist is cached...
if ((! defined $playlist{SEARCH_TAGS}) &&
($command !~ /^refresh/i)) {
xmms_refresh(\&xmms_handler, ["$command " . join(" ", @tokens)]);
return;
}
# looks good; scan for a command that was sent to us
if ($command =~ /^auto$/i) {
xmms_auto(@tokens);
}
elsif ($command =~ /^colo/i) {
xmms_color(@tokens);
}
elsif ($command =~ /^dcc$/i) {
xmms_play("DCC", @tokens);
}
elsif ($command =~ /^debug$/i) {
xmms_debug(@tokens);
}
elsif ($command =~ /^help$/i) {
xmms_help(@tokens);
}
elsif ($command =~ /^language$/i) {
xmms_language(@tokens);
}
elsif ($command =~ /^list$/i) {
xmms_play("LIST", @tokens);
}
elsif ($command =~ /^msg$/i) {
$state{remote_nick} = shift (@tokens);
xmms_query(\&print_msg, @tokens);
}
elsif ($command =~ /^play$/i) {
xmms_play("PLAY", @tokens);
}
elsif ($command =~ /^query$/i) {
xmms_query(\&print_window, @tokens);
}
elsif ($command =~ /^remote$/i) {
xmms_remote(@tokens);
}
elsif ($command =~ /^refresh$/i) {
xmms_refresh();
}
elsif ($command =~ /^send$/i) {
xmms_send(@tokens);
}
elsif ($command =~ /^tell$/i) {
xmms_tell(@tokens);
}
elsif ($command =~ /^topic$/i) {
xmms_query(\&print_topic, @tokens);
}
elsif ($command =~ /^transfer/i) {
xmms_transfer(@tokens);
}
elsif ($command =~ /^yell$/i) {
xmms_query(\&print_channel, @tokens);
}
else {
print_window ("Unknown /xmms command (try /xmms help)");
}
return 1;
}
############ Main handlers
sub xmms_privmsg {
my $line = shift;
my $THROTTLE = 5; # max number of results to return (larger than 5 is problematic)
my ($from, $irc_msg, $to, $message) = split (/\s+/, $line, 4);
if ($message =~ /^:xmms-request\s+(.*)$/i) {
$message = $1;
if ($state{debug}) {
$state{debug}->print("Recieved PRIVMSG [$line]\n");
$state{debug}->print("SPLIT :" . join (", ", ($from, $irc_msg, $to, $message)). "\n");
}
# looks like we got a request
if (($to eq IRC::get_info(1)) && ($from =~ /!/)) {
my ($nick, $email) = split (/!/, $from, 2);
$nick =~ s/^://;
$state{remote_nick} = $nick;
unless (defined $state{remote_enabled}) {
print_msg ("xchat-xmms: Sorry, remote access to this playlist is currently disabled.");
return 1;
}
my ($command, $arg) = split (/\s+/, $message, 2);
# sanitize arg; you never know if there are naughty people... ;)
$arg =~ s/[^\w\s\$\^\.\*]//g;
if ($command =~ /^list$/i) {
my $raw_re = $arg;
my %result_set;
foreach my $list ($playlist{FILES}, $playlist{TITLES},
$playlist{SEARCH_TAGS}) {
for (my $i=0; $i <= $#$list; $i++) {
if ($list->[$i] =~ /$raw_re/i) {
$result_set{"$i"} = $list->[$i];
}
}
}
my @results = sort (keys %result_set);
print_window(" .:. $nick is browsing your playlist => " . scalar(@results) .
" results for /$raw_re/");
if (@results == 0) {
print_msg ("xchat-xmms: No songs match the expression /$raw_re/");
}
else {
print_msg("xchat-xmms: Search results for /$raw_re/");
while (my $playlist_ent = shift (@results)) {
last if (--$THROTTLE < 0);
print_msg(sprintf("xchat-xmms: %04d", $playlist_ent) . " => " .
$result_set{$playlist_ent});
}
if (scalar (@results) > 0) {
print_msg("xchat-xmms: " . scalar (@results) . " other matches not sent");
}
else {
print_msg("xchat-xmms: End of search results for /$raw_re/");
}
}
}
elsif ($command =~ /^send$/i) {
if ($state{transfers}) {
# make sure argument is a song number
if ($arg =~ /^\d+$/) {
# make sure song number is valid
my $max = (scalar @{$playlist{FILES}}) - 1;
if (($arg <0) || ($arg > $max)) {
print_msg("xchat-xmms: DCC send request file number [$arg] is out of range [0 - $max]");
}
else {
do_dcc($nick, $playlist{FILES}->[$arg]);
}
}
else {
print_msg("xchat-xmms: DCC send request must be followed by a song number (use list to find it)");
}
}
else {
print_msg ("xchat-xmms: DCC send requests not enabled, but if you ask nicely...");
}
}
else {
my @lines = split (/\n/, $remote_help);
foreach my $line (@lines) {
print_msg("xchat-xmms: $line");
}
}
}
else {
print_window (" -= XChat-XMMS recieved an anonymous request from ($from); ignoring");
}
}
else {
return undef; # let xchat handle this one
}
return 1;
}
#
# callback handlers follow
#
#
# Auto
#
sub xmms_auto {
# TODO: BE ABLE TO LIST ALL ACTIVE AUTO COMMANDS
my $subdomain = shift;
my @args = @_;
if ($subdomain =~ /^cancel/i) {
my $type = shift (@args);
if ($type =~ /^query/i) {
$state{auto_queue}->{QUERY} = undef;
print_window(" -= auto-query deactivated");
}
elsif ($type =~ /^topic/i) {
my $channel = shift (@args);
if (defined $state{auto_queue}->{TOPIC}->{$channel}) {
delete($state{auto_queue}->{TOPIC}->{$channel});
print_window(" -= auto-topic to $channel deactivated");
}
else {
print_window(" ?= not currently setting topic on channel \"$channel\"");
}
}
elsif ($type =~ /^yell/i) {
my $channel = shift (@args);
if (defined $state{auto_queue}->{YELL}->{$channel}) {
delete($state{auto_queue}->{YELL}->{$channel});
print_window(" -= auto-yell to $channel deactivated");
}
else {
print_window(" ?= not currently yelling on channel \"$channel\"");
}
}
else {
print_window ("Unknown auto cancel command (try /xmms help)");
}
}
elsif ($subdomain =~ /^delay/i) {
# change the minimum delay
my $new_delay = shift (@args);
if ($new_delay =~ /^\d+$/) {
if ($new_delay < 60) {
print_window (" != short auto-delay times may annoy other IRC users");
}
$state{auto_queue}->{MIN_SECS} = $new_delay;
print_window (" += auto-delay time set to $new_delay seconds");
}
else {
print_window (" += auto-delay time set to " .
$state{auto_queue}->{MIN_SECS} . " seconds");
}
}
elsif ($subdomain =~ /^list/i) {
# list all active auto commands
foreach my $group ( [ $state{auto_queue}->{YELL}, "Yells", "yell" ],
[ $state{auto_queue}->{TOPIC}, "Topics", "topic" ]) {
my @channels = sort keys %{$group->[0]};
if (@channels > 0) {
print_window("Active " . $group->[1]);
foreach my $channel (@channels) {
print_window (" += $channel" .
"(\"/xmms auto cancel " . $group->[2] .
" $channel\" to deactivate)");
}
}
}
if ($state{auto_queue}->{QUERY} > 0) {
print_window ("Auto Query is Active (\"/xmms auto cancel query\" to deactivate)");
}
}
elsif ($subdomain =~ /^query/i) {
# user wants to auto-send song changes to the private XChat window
$state{auto_queue}->{QUERY} = 1;
$state{auto_queue}->{SONG} = $remote->get_playlist_pos();
print_window(" += auto-query active (\"/xmms auto cancel query\" to stop)");
}
elsif ($subdomain =~ /^topic/i) {
# user wants to auto-set song changes to channel topic
my $channel = $args[0] || IRC::get_info(2);
if ($channel =~ /^\#.+/) {
print_window (" += auto-topic active for channel $channel " .
"(\"/xmms auto cancel topic $channel\" to stop)");
$state{auto_queue}->{TOPIC}->{$channel} = 1;
$state{auto_queue}->{SONG} = $remote->get_playlist_pos();
}
else {
print_window ("Unknown auto command [channel error?!] (try /xmms help)");
}
}
elsif ($subdomain =~ /^yell/i) {
# user wants to auto-send song changes to a channel (* = all channels joined [ANNOYING!])
my $channel = $args[0] || IRC::get_info(2);
if ($channel =~ /^\#.+/) {
print_window (" += auto-yell active for channel $channel " .
"(\"/xmms auto cancel yell $channel\" to stop)");
$state{auto_queue}->{YELL}->{$channel} = 1;
$state{auto_queue}->{SONG} = $remote->get_playlist_pos();
}
elsif ($channel eq "*") {
print_window (" += auto-yell active for -=ALL CHANNELS JOINED=- " .
"(\"/xmms auto cancel yell $channel\" to stop)");
print_window (" != XChat-XMMS author not responsible for your KICKBANS!");
$state{auto_queue}->{YELL}->{$channel} = 1;
$state{auto_queue}->{SONG} = $remote->get_playlist_pos();
}
else {
print_window ("Unknown auto command ['$channel' bad channel?] (try /xmms help)");
}
}
else {
print_window ("Unknown auto command (try /xmms help)");
}
}
sub xmms_auto_work {
# handle auto* calls
if (time() > ($state{auto_queue}->{LAST_UPDATE} +
$state{auto_queue}->{MIN_SECS})) {
# we've passed the minimum delay; let's see what needs to be done
if ($remote->is_playing()) {
# don't bother if XMMS is stopped
my $song = $remote->get_playlist_pos();
if ($song != $state{auto_query}->{SONG}) {
# return if the same song is still playing
$state{auto_query}->{SONG} = $song; # mark this song as the "current song"
my $song_info = get_song_info($song);
my $output_string = join (" .:. ", @$song_info);
my $nick = IRC::get_info(1);
# auto-send to XChat window?
# if ($state{auto_queue}->{QUERY} > 0) {
# print_window($output_string);
# }
# auto-send to a channel?
my @channels = keys %{$state{auto_queue}->{YELL}};
if (@channels > 0) {
my $current_channel = IRC::get_info(2);
foreach my $channel (@channels) {
if (($channel eq "*") &&
(! defined ($state{auto_queue}->{YELL}->{$current_channel}))) {
print_channel ("$JAMMING \"$output_string\" $JAMMING2");
}
else {
$state{remote_nick} = $channel;
print_msg("$nick $JAMMING \"$output_string\"");
print_window_long($channel, undef, "$nick $JAMMING \"$output_string\"");
}
}
}
# auto-send to a topic?
@channels = keys %{$state{auto_queue}->{TOPIC}};
if (@channels > 0) {
my $current_channel = IRC::get_info(2);
my $nick = IRC::get_info(1);
foreach my $channel (@channels) {
print_topic_channel ($channel, "$nick $JAMMING \"$output_string\"");
}
}
} # if ($song != $state{auto_query}->{SONG})
} # if ($remote->is_playing())
$state{auto_queue}->{LAST_UPDATE} = time();
} # if ( time () > ..... )
IRC::add_timeout_handler(5000, "xmms_auto_work");
return 1;
}
#
# Debug
#
sub xmms_debug {
my $filename = shift;
if (defined $state{debug}) {
$state{debug}->close();
$state{debug} = undef;
print_window(" -= XChat-XMMS debugging finished");
}
elsif (defined $filename) {
$state{debug} = new IO::File ">>$filename";
if (defined $state{debug}) {
my $current_fh = select();
select $state{debug};
$| = 1; # turn off file buffering on log file
select $current_fh;
print_window(" += XChat-XMMS debugging started");
}
else {
print_window(" -= Unable to open \"$filename\" for appending: $! [Debugging OFF]");
}
}
}
#
# Color
#
sub xmms_color {
my $new_color = shift;
$new_color = lc($new_color);
if ($new_color eq "none") {
foreach my $type (qw (CHANNEL MSG TOPIC WINDOW)) {
$COLORS{$type} = [ ".:| ", "" ];
}
}
else {
unless (defined $GENERIC_COLORS{$new_color}) {
print_window("No such color [$new_color]; try /xmms help colors for a list");
return;
}
my $color = $GENERIC_COLORS{$new_color};
foreach my $type (qw (CHANNEL MSG TOPIC WINDOW)) {
$COLORS{$type} = [ "\003" . $color . ".:| ", "\003" ];
}
}
print_window("Set XChat-XMMS color to $new_color");
return;
}
#
# Language
#
sub xmms_language {
my $new_language = shift;
if ($new_language =~ /^en$/) {
print_window ("Language set to English");
}
else {
print_window ("Only english is available at the moment");
}
}
#
# Queries
#
sub xmms_query {
my $print_function = shift @_;
my $subdomain = shift @_;
my @args = @_;
if ($subdomain =~ /^song$/i) {
# Query for the currently playing song
if ($remote->is_playing()) {
my $song = $remote->get_playlist_pos();
my $song_info = get_song_info($song);
my $time = format_time($remote->get_output_time());
if ($remote->is_paused()) {
&$print_function (" $JAMMING [PAUSED] [$time] " .
join (" .:. ", @$song_info));
}
else {
&$print_function ("$JAMMING [PLAYING] [$time] " .
join (" .:. ", @$song_info));
}
}
else {
&$print_function ("XMMS is not currently playing any song");
}
}
elsif ($subdomain =~ /^file$/i) {
# user wants the file path instead of any tag information we may have
if ($remote->is_playing()) {
my $file = $remote->get_playlist_file();
my $time = format_time($remote->get_output_time());
if ($remote->is_paused()) {
&$print_function (" $JAMMING [PAUSED] [$time] $file" );
}
else {
&$print_function ("$JAMMING [PLAYING] [$time] $file" );
}
}
else {
&$print_function ("XMMS is not currently playing any song");
}
}
elsif ($subdomain =~ /^version$/) {
&$print_function ("XMMS Version " . $remote->get_version );
}
elsif ($subdomain =~ /^vol/) {
my $volume = $remote->get_volume();
my $hashes = $volume / 2;
my $blanks = 50 - $hashes;
&$print_function ("Vol [" . ("#" x $hashes) . (" " x $blanks) . "] <" .
sprintf ("%02d", $volume) . ">");
}
elsif ($subdomain =~ /^time$/) {
my $time = format_time($remote->get_output_time());
&$print_function ("[$time]");
}
else {
print_window ("Unknown query/yell command (try /xmms help)");
}
}
sub xmms_send {
my $nick = shift;
if ($remote->is_playing()) {
my $song = $remote->get_playlist_pos();
do_dcc($nick, $playlist{FILES}->[$song]);
}
else {
print_window ("XMMS is not currently playing any song");
}
}
#
# Remote (PRIVMSG) Subs
#
sub xmms_remote {
my $subdomain = shift;
my @args = @_;
if ($subdomain =~ /^enable/) {
# enable remote browsing of our lists
$state{remote_enabled} = 1;
print_window (" += Allowing remote access to playlist");
}
elsif ($subdomain =~ /^disable/) {
$state{remote_enabled} = undef;
print_window (" -= Forbidding remote access to playlist");
}
else {
print_window ("Unknown remote command (try /xmms help)");
}
}
#
# Refresh playlist cache
#
sub xmms_refresh {
# capture any callback subs we need to activate after we're done searching
$state{resume_sub} = shift;
$state{resume_args} = shift;
$state{resume_channel} = IRC::get_info(2);
$state{resume_server} = IRC::get_info(3);
# a stub that warns the user that this could take some time
# (It takes about 10 seconds for a 3000-song list on my 1Ghz machine
# that mounts all the songs over NFS)
print_window("Indexing current playlist for quick response times.");
print_window("This could take some time and XChat may become " .
"unresponsive, please wait...");
# XChat can become unresponsive for a LONG time doing this
# traversal, and that leads to connection problems sometimes, so we
# solve this the old fasioned way by jumping back to XChat after so
# many tracks are read so that it can handle pending events (ie,
# cooperative multitasking)
# a lame attempt to make this reentrant (I don't think XChat does
# multithreaded perl scripts, but you never know...
if (defined $state{refresh_files}) {
# print a big warning to the XChat screen
print_window("**************************");
print_window("**************************");
print_window("**XCHAT-XMMS MUTEX ERROR**");
print_window("**************************");
print_window("**************************");
print_window("This should never happen; please send mail to ink\@inconnu.isu.edu");
}
$state{refresh_files} = undef;
$state{refresh_titles} = undef;
$state{refresh_start} = undef;
IRC::add_timeout_handler(500, "xmms_refresh_work");
}
sub xmms_refresh_work {
my $BATCH_SIZE = 25; # number to do in a batch
my $UPDATE_SIZE = 250;
my ($files, $titles, $start, $end);
if (defined $state{refresh_files}) {
# we're resuming after a break; continue where we left off
$files = $state{refresh_files};
$titles = $state{refresh_titles};
$start = $state{refresh_start};
}
else {
# first time we've been called; setup everything
$files = $remote->get_playlist_files();
$titles = $remote->get_playlist_titles();
$state{refresh_files} = $files;
$state{refresh_titles} = $titles;
$playlist{FILES} = $files;
$playlist{TITLES} = $titles;
$playlist{SEARCH_TAGS} = [];
$playlist{TAGS} = [];
$start = 0;
}
my $num_files = scalar (@$files);
if (($num_files - $start) > $UPDATE_SIZE) {
$end = $start + $UPDATE_SIZE;
}
else {
$end = $num_files;
}
if (defined $state{have_mp3info}) {
# get MP3 ID tags
for (my $song=$start; $song < $end; $song++) {
my $file = $playlist{FILES}->[$song];
next unless ($file =~ /mp3$/i);
if (my $tag = get_mp3tag($file)) {
if ($tag->{TITLE} =~ /\S/) {
store_tag($tag, $song);
}
}
}
}
if (defined $state{have_ogg}) {
# get OGG ID tags
for (my $song=$start; $song < $end; $song++) {
my $file = $playlist{FILES}->[$song];
next unless ($file =~ /ogg$/i);
$file =~ s/\"/\\\"/g;
if (open(OGG, "$VORBIS_PATH \"$file\"|")) {
my $tag = {};
while (my $line = <OGG>) {
$line =~ /\s+$/;
my ($key, $value) = split (/\=/, $line, 2);
$key = uc($key);
if ((defined $key) && (defined $value)) {
$tag->{$key} = $value;
}
}
if ($tag->{TITLE} =~ /\S/) {
store_tag($tag, $song);
}
close OGG;
}
}
}
if ($end == $num_files) {
# All done!
print_window_long($state{resume_channel}, $state{resume_server},
"Refreshed playlist cache ($num_files files)");
# clean up unused refs
$state{refresh_files} = undef;
$state{refresh_titles} = undef;
$state{refresh_start} = undef;
# resume with original xmms command, if available
if (defined $state{resume_sub}) {
$state{resume_sub}->(@{$state{resume_args}});
$state{resume_sub} = undef;
}
}
else {
# need to call us again, after allowing XChat to update for half a second
if (($end % $BATCH_SIZE) == 0) {
# update the display occasionally
print_window_long($state{resume_channel}, $state{resume_server},
" += Examined $end/$num_files files");
}
$state{refresh_start} = $end; # record where we stopped
IRC::add_timeout_handler(500, "xmms_refresh_work");
}
return ();
}
#
# Searches
#
sub xmms_play {
my $flag = shift;
my $nick = undef;
if ($flag eq "DCC") {
# if the flag is set to dcc, we need to extract a nickname before looking
# at the song
$nick = shift;
}
my $song = join (" ", @_); # put the rest of the arguments together as a song query
if ($song =~ /^\s*$/) {
if ($flag eq "PLAY") {
xmms_tell ("play");
}
elsif ($flag eq "DCC") {
print_window("Unable to understand $flag command (try /xmms help)");
}
}
elsif ($song =~ /^\d+$/) {
# numerical response; jump to that song in the playlist
my $playlist_length = $remote->get_playlist_length();
if (($song < 1) || ($song > ($playlist_length + 1))) {
print_window ("Song out of range (1 - $playlist_length)");
}
elsif ($flag eq "PLAY") {
$remote->set_playlist_pos($song);
wait_a_bit();
if (! $remote->is_playing()) {
xmms_tell("PLAY");
}
else {
xmms_query(\&print_window, "song");
}
}
elsif ($flag eq "DCC") {
do_dcc($nick, $playlist{FILES}->[$song]);
}
else {
print_window ("Song $song => " . $playlist{TITLES}->[$song] .
" (" . $playlist{FILES}->[$song] . ")");
}
}
elsif ($song =~ /^\/(.+)\/$/) {
# regular expression
my $raw_re = $1;
my %result_set;
foreach my $list ($playlist{FILES}, $playlist{TITLES},
$playlist{SEARCH_TAGS}) {
for (my $i=0; $i <= $#$list; $i++) {
if ($list->[$i] =~ /$raw_re/i) {
$result_set{"$i"} = $list->[$i];
}
}
}
my @results = sort (keys %result_set);
if (@results == 0) {
print_window ("No songs match the expression /$raw_re/");
}
elsif (@results == 1) {
if ($flag eq "PLAY") {
$remote->set_playlist_pos($results[0]);
wait_a_bit();
if(! $remote->is_playing()){
xmms_tell("PLAY");
} else {
xmms_query(\&print_window, "song");
}
}
elsif ($flag eq "DCC") {
do_dcc($nick, $playlist{FILES}->[$results[0]]);
}
else {
print_window("Search results for /$raw_re/");
print_window(sprintf(" %04d", $results[0]) . " => " .
$result_set{$results[0]});
}
}
else {
print_window("Search results for /$raw_re/");
foreach my $playlist_ent (@results) {
print_window(sprintf(" %04d", $playlist_ent) . " => " .
$result_set{$playlist_ent});
}
}
}
else {
print_window ("Unable to understand $flag command (try /xmms help)");
print_window ("I can understand song numbers or searches (which must be enclosed" .
" in forward slashes), for example:");
print_window (" /xmms $flag 1234");
print_window (" /xmms $flag /radiohead/");
}
}
#
# Tell commands
#
sub xmms_tell {
my $subdomain = shift @_;
my @args = @_;
if ($subdomain =~ /^next$/i) {
# go to the next song
$remote->playlist_next;
wait_a_bit();
xmms_query (\&print_window, "song");
}
elsif ($subdomain =~ /^prev/i) {
# go to the previous song
$remote->playlist_prev;
wait_a_bit();
xmms_query (\&print_window, "song");
}
elsif ($subdomain =~ /^pause$/i) {
# pause the current song
$remote->pause;
wait_a_bit();
xmms_query (\&print_window, "song");
}
elsif ($subdomain =~ /^stop$/i) {
# stop playing
$remote->stop;
}
elsif ($subdomain =~ /^play$/i) {
# start playing
$remote->play;
wait_a_bit();
xmms_query (\&print_window, "song");
}
elsif ($subdomain =~ /^jump$/i) {
# jump to a spot in this song
my $new_time = $args[0];
# user included minutes??
if ($new_time =~ /:/) {
my ($minutes, $seconds) = split (/:/, $new_time, 2);
$new_time = $seconds + ($minutes * 60);
}
# user is using a percent??
elsif ($new_time =~ /^(\d+)\%$/) {
if (($new_time > 99) || ($new_time < 0)) {
print_window("Percentages must be between 0 and 99");
return;
}
else {
my $song_length = $remote->get_playlist_time
($remote->get_playlist_pos);
$new_time = int ($song_length * ( $new_time / 100.0)) / 1000;
}
}
$new_time *= 1000;
$remote->jump_to_time($new_time);
wait_a_bit();
xmms_query (\&print_window, "song");
}
elsif ($subdomain =~ /^vol/i) {
# set volume level
my $new_vol = int($args[0]);
if (($new_vol < 0) || ($new_vol > 100)) {
print_window("New volume must be between 0 and 100");
}
$remote->set_volume($new_vol);
wait_a_bit();
xmms_query (\&print_window, "vol");
}
elsif ($subdomain =~ /^shuf/i) {
# toggle shuffle
$remote->toggle_shuffle();
wait_a_bit();
if ($remote->is_shuffle()) {
print_window("Shuffle is [ENABLED]");
}
else {
print_window("Shuffle is [DISABLED]");
}
}
elsif ($subdomain =~ /^repeat/i) {
# toggle repeat
$remote->toggle_repeat();
wait_a_bit();
if ($remote->is_repeat()) {
print_window("Repeat is [ENABLED]");
}
else {
print_window("Repeat is [DISABLED]");
}
}
else {
print_window("Unknown tell command (try /xmms help for more information)");
}
}
#
# Transfer (remote DCC)
#
sub xmms_transfer {
my $subdomain = shift;
my @args = @_;
if ($subdomain =~ /^enable/) {
# enable remote transfers of our files
$state{transfers} = 1;
print_window (" += Allowing remote DCC transfers of our playlist");
}
elsif ($subdomain =~ /^disable/) {
$state{remote_enabled} = undef;
print_window (" -= Forbidding remote DCC transfers of our playlist");
}
else {
print_window ("Unknown transfer command (try /xmms help)");
}
}
#
# Help
#
sub xmms_help {
my $arg = shift;
my @lines;
if ($arg =~ /^example/i) {
@lines = split (/\n/, $examples);
}
elsif ($arg =~ /^remote/i) {
@lines = split (/\n/, $remote_help);
}
elsif ($arg =~ /^colo/i) {
push @lines, ("Available Colors ==>");
push @lines, (keys %GENERIC_COLORS);
push @lines, "none";
}
else {
@lines = split (/\n/, $usage);
}
foreach my $line (@lines) {
print_window ($line);
}
}
#
# utility functions
#
sub are_attached {
unless ($remote->is_running) {
print_window ("XMMS is not currently running\n");
return undef;
}
return 1;
}
# do_dcc: actually initiate a DCC session
sub do_dcc {
my ($nick, $filename) = @_;
unless ($nick =~ /\S/) {
print_window ("Unable to initiate DCC without a nickname");
return;
}
unless (-r $filename) {
print_window ("Unable to read \"$filename\" : $!");
return;
}
$filename =~ s/\"/\\\"/g;
my $cmd = "/dcc send $nick \"$filename\"";
print_window (" +=DCC [$cmd]");
IRC::command ($cmd);
}
sub format_time {
my $xmms_time = shift;
my $ms = $xmms_time % 1000;
my $s = $xmms_time / 1000;
my $min = $s / 60;
$s = $s % 60;
return sprintf("%02d:%02d:%03d", $min, $s, $ms);
}
sub get_song_info {
my $song = shift;
my @song_info;
### who-ha edit ###
# if (defined $playlist{TAGS}->[$song]) {
# if (defined $playlist{TAGS}->[$song]->{TITLE}) {
# push @song_info, $playlist{TAGS}->[$song]->{TITLE};
# }
# if (defined $playlist{TAGS}->[$song]->{ARTIST}) {
# push @song_info, $playlist{TAGS}->[$song]->{ARTIST};
# }
# if (defined $playlist{TAGS}->[$song]->{ALBUM}) {
# push @song_info, $playlist{TAGS}->[$song]->{ALBUM};
# }
# if (defined $playlist{TAGS}->[$song]->{TRACK}) {
# push @song_info, "Track " . $playlist{TAGS}->[$song]->{TRACK};
# }
# }
# else {
my $title = $remote->get_playlist_title();
@song_info = split(/ : /,$title);
# }
#####################
return \@song_info;
}
sub print_channel {
IRC::command ($COLORS{CHANNEL}->[0] . $_[0] . $COLORS{CHANNEL}->[1]);
if ($state{debug}) {
$state{debug}->print("YELL " . $_[0] . "\n");
}
}
sub print_msg {
# RFC 1459 example:
# :Angel PRIVMSG Wiz :Hello are you receiving this message ?
# ; Message from Angel to Wiz.
my $message = shift;
my $nick = IRC::get_info(1);
my $string = ":$nick PRIVMSG " . $state{remote_nick} .
" :" . $COLORS{MSG}->[0] . $message . $COLORS{MSG}->[1] . "\r\n";
#IRC::send_raw(":$nick PRIVMSG " . $state{remote_nick} .
# " :\0035:: $message\003\r\n");
if (($message =~ /\S/) && ($nick =~ /^\S+$/) &&
($state{remote_nick} =~ /\S/)) {
IRC::send_raw($string);
}
else {
print_window ("Unable to send private message [$message] to [" .
$state{remote_nick} . "] from [$nick]");
}
if ($state{debug}) {
$state{debug}->print ($string);
}
}
sub print_topic {
my $message = shift;
my $nick = IRC::get_info(1);
my $channel = IRC::get_info(2);
if (($channel =~ /^\#\S+$/) && ($nick =~ /^\S+$/)) {
IRC::send_raw(":$nick TOPIC $channel :$nick $JAMMING " .
$COLORS{TOPIC}->[0] . $message . $COLORS{TOPIC}->[1] . "\r\n");
}
else {
print_window ("Unable to set the topic [channel=\"$channel\" nick=\"$nick\"]");
}
if ($state{debug}) {
$state{debug}->print ("TOPIC " . $_[0] . "\n");
}
}
sub print_topic_channel {
# RFC 1459 example:
# :Wiz TOPIC #test :New topic ;User Wiz setting the topic.
my $channel = shift;
my $message = shift;
my $nick = IRC::get_info(1);
if (($channel =~ /^\#\S+$/) && ($nick =~ /^\S+$/)) {
IRC::send_raw(":$nick TOPIC $channel :$message\r\n");
}
else {
print_window ("Unable to set the topic [channel=\"$channel\" nick=\"$nick\"]");
}
if ($state{debug}) {
$state{debug}->print ("TOPIC_CHANNEL $message\n");
}
}
sub print_window {
my $string = $COLORS{WINDOW}->[0] . $_[0] . $COLORS{WINDOW}->[1] . " \n";
IRC::print ($string);
if ($state{debug}) {
$state{debug}->print ("WINDOW " . $string);
}
}
sub print_window_long {
# The function you want is: IRC::Print_with_channel
# It takes three string arguments: output string, channel(tab name), server
my ($channel, $server, $message) = @_;
IRC::print_with_channel ($COLORS{WINDOW}->[0] . $message . $COLORS{WINDOW}->[1] . " \n",
$channel, $server);
if ($state{debug}) {
$state{debug}->print ("WINDOW_LONG " . $_[0] . "\n");
}
}
# store_tag: store a song's meta (mp3/ogg) tag in a global hash
sub store_tag {
my ($tag, $song) = @_;
# Make sure tags are either there, or undef'd and that they don't
# contain wierd whitespace
foreach my $tag_name (keys %$tag) {
$tag->{$tag_name} =~ s/[\n\r\t]//g;
unless (($tag_name =~ /\S/) ||
($tag->{$tag_name} =~ /\S/)) {
$tag->{$tag_name} = undef;
}
}
# the many ways people store track information.... [sigh]
my $track = undef;
if (defined $tag->{TRACK}) {
$track = $tag->{TRACK};
}
elsif (defined $tag->{"TRACK-NUM"}) {
$track = $tag->{"TRACK-NUM"};
}
elsif (defined $tag->{"TRACKNUM"}) {
$track = $tag->{"TRACKNUM"};
}
if ($track =~ /^\s*(\d+)/) {
# get rid of 4/12, 4\12, 4 of 12, etc.
$track = $1;
}
$tag->{TRACK} = $track;
# Store individual song elements
$playlist{TAGS}->[$song] =
{
TITLE => $tag->{TITLE},
ARTIST => $tag->{ARTIST},
ALBUM => $tag->{ALBUM},
TRACK => $track
};
# Store a string to make searching easier
if (defined $tag->{TRACK}) {
$playlist{SEARCH_TAGS}->[$song] =
join (", ", ($tag->{TITLE}, $tag->{ARTIST}, $tag->{ALBUM},
"[Track " . $tag->{TRACK} . "]"));
}
else {
$playlist{SEARCH_TAGS}->[$song] =
join (", ", ($tag->{TITLE}, $tag->{ARTIST}, $tag->{ALBUM}));
}
return;
}
sub test_mp3info {
# see if we can find the MP3::Info Perl module
eval { require MP3::Info; };
unless ($@) {
require "MP3/Info.pm" or die $!;
import MP3::Info;
print_window (" += MP3::Info support enabled");
return 1;
}
print_window (" -= MP3::Info Perl module not found, MP3 tags disabled");
return undef;
}
sub test_usleep {
# see if this system has usleep on it
eval { require Time::HiRes; };
if ($@) {
print_window (" -= Time::HiRes Perl module not found, sleeps will all be 1 second " .
"(consider installing please)");
return undef;
}
require "Time/HiRes.pm" or die $!;
import Time::HiRes qw(usleep);
return 1;
}
sub test_vorbis {
# see if we can find the vorbiscomment program
unless (open PIPE, "$VORBIS_PATH |") {
print_window (" -= vorbiscomment unavailable ($!); OGG tags disabled");
return undef;
}
print_window (" += Ogg/Vorbis support enabled");
close PIPE;
return 1;
}
sub wait_a_bit {
# wait for about a third second if possible; wait for a full second otherwise
# this function gives xmms time to synch up with xchat-xmms; if you notice
# that queries are returning incorrect results after a change (ie, /xmms tell next)
# then you can increase this number to give XMMS more time to mull it over.
if ($state{have_usleep}) {
# neat, we can wait for fractions of a second
usleep (300000);
}
else {
# oh well, wait for a full second
sleep 1;
}
return;
}