foo_spam.pl

   1 #! /usr/bin/env perl
   2 #
   3 # foo_spam - Prints the currently playing song from foobar2000.
   4 #
   5 # Copyright (c) 2009-2010, Diogo Franco <diogomfranco@gmail.com>
   6 #
   7 # Permission to use, copy, modify, and/or distribute this software for any
   8 # purpose with or without fee is hereby granted, provided that the above
   9 # copyright notice and this permission notice appear in all copies.
  10 #
  11 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  12 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  13 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  14 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  15 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  16 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  17 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  18
  19 use warnings;
  20 use strict;
  21 use utf8;
  22 use Encode;
  23
  24 use Net::Telnet;
  25 use File::Path;
  26 use Time::HiRes qw(usleep);
  27
  28 BEGIN {
  29         *HAVE_XCHAT = Xchat->can('register') ? sub {1} : sub {0};
  30         *HAVE_IRSSI = Irssi->can('command_bind') ? sub{1} : sub{0};
  31         *HAVE_WEECH = weechat->can('register') ? sub {1} : sub {0};
  32 }
  33
  34 my $ver = '0.6.1';
  35 my %info = (
  36         author      => 'Kovensky',
  37         contact     => '#shameimaru@irc.rizon.net',
  38         url         => 'http://repo.or.cz/w/foo_spam.git',
  39         name        => 'foo_spam',
  40         description => 'Prints the currently playing song from foobar2000.',
  41         license     => 'ISC'
  42 );
  43
  44 if (HAVE_IRSSI) {
  45         our $VERSION = $ver;
  46         our %IRSSI = %info;
  47 }
  48
  49 Xchat::register($info{name}, $ver, $info{description}, \&close_telnet) if HAVE_XCHAT;
  50 weechat::register($info{name}, $info{author}, $ver, $info{license}, $info{description}, 'close_telnet', 'UTF-8') if HAVE_WEECH;
  51 # ChangeLog:
  52 # 0.6.1 - Added weechat support.
  53 # 0.6   - Backwards incompatible version. Changes the format syntax, documents functions, implement some others.
  54 # 0.5.2 - Added discnumber and totaldiscs tags. Changed default format. Silences a warning when a function ends on ",)". Fixed two warnings in the $if family.
  55 # 0.5.1 - Fixed $if, $if2, $and, $or and $xor behavior on certain strings.
  56 # 0.5   - Support subfunctions and tags with underlines. Changed some other details.
  57 # 0.4   - Fixed UTF-8 corruption issues. Allow the user to specify a comment when using /aud by giving it as an argument. Document build_output.
  58 # 0.3.2 - Change the method used to read foobar2000's response. The previous method would hang once in a while.
  59 # 0.3.1 - Change default settings to avoid breakage if a track has | on one of the tags. Update documentation.
  60 # 0.3   - Allow customization of the format string. Changed method of desync handling.
  61 # 0.2.2 - Fix desync issues if foobar takes "too long" to respond. Added codec and bitrate to the output.
  62 # 0.2.1 - Forgot to handle one error case on the telnet connection.
  63 # 0.2   - Changed the recommended string and output. Fixed my wrong XChat API usage. Changed the way the telnet connection is handled.
  64 # 0.1   - First version
  65
  66 # Known Bugs:
  67 # Doesn't support tags that are equal to "?" (foo_controlserver limitation).
  68
  69 # TODO:
  70 # Replace the current format syntax by foobar2000's title format
  71
  72 our $telnet_open    = 0;
  73 our $telnet         = undef;
  74 our $default_format = <<'EOF';
  75 $left(%_foobar2000_version%,10) ($replace(%_foobar2000_version%,foobar2000 ,)):
  76  [%album artist% ]'['[%date% ][%album%][ #[%discnumber%.]%tracknumber%[/[%totaldiscs%.]%totaltracks%]]']'
  77  [%track artist% - ]%title% '['%playback_time%[/%length%]']'[ %bitrate%kbps][ %codec%[ %codec_profile%]][ <-- %comment%]
  78 EOF
  79 $default_format =~ s/\R//g;
  80 our $format         = $default_format;
  81 our %heap;
  82
  83 our $setting_file   = undef; # Only used by Xchat
  84
  85 sub open_telnet {
  86         $telnet = new Net::Telnet(Port => 3333, Timeout => 10, Errmode => 'return') if not defined($telnet);
  87         $telnet_open = $telnet->open("localhost");
  88         unless($telnet_open) {
  89                 irc_print("Error connecting to foobar2000! Make sure fb2k is running.");
  90                 irc_print("Also check if foo_controlserver is properly configured.");
  91         }
  92         return $telnet_open;
  93 }
  94
  95 sub close_telnet {
  96         if($telnet_open) {
  97                 $telnet_open = 0;
  98                 $telnet->put("exit\n");
  99                 $telnet->close;
 100         }
 101 }
 102
 103 sub get_track_info {
 104         return undef unless open_telnet();
 105
 106         my $line = undef;
 107
 108         unless (defined($telnet->print("trackinfo"))) {
 109                 close_telnet();
 110                 return undef unless open_telnet();
 111         }
 112
 113         my @result = $telnet->waitfor(Match => '/11[123]\|+.+?\|+.+?\|+(?!0\.[0-5][0-9]).*/', Timeout => 5);
 114
 115         $line = $result[1] if @result;
 116
 117         close_telnet();
 118
 119         unless($line) {
 120                 irc_print("Error retrieving status from foobar2000!");
 121                 return undef;
 122         }
 123
 124         unless (eval { $line = decode("UTF-8", $line, Encode::FB_CROAK) }) {
 125                 irc_print("Error: line is not valid UTF-8. Check foo_controlserver's settings.");
 126                 return undef;
 127         }
 128
 129         %heap = ();
 130
 131         my @fields;
 132
 133         if($line =~ /^11.\|\|\|/ and $line =~ /\|\|\|(.*?)\|\|\|$/) { # proper setting
 134                 @fields = split(/\|\|\|/, $line);
 135         } else {                    # the luser didn't configure it correctly
 136                 $line =~ s/\|\|\|/\|/g; # fix possible half-configuration
 137                 @fields = split(/\|/, $line);
 138         }
 139
 140         # Standard settings
 141         my $info = {state                  => $fields[0],
 142                     playback_time_seconds  => $fields[3],
 143                     codec                  => $fields[4],
 144                     bitrate                => $fields[5],
 145                     'album artist'         => $fields[6],
 146                     album                  => $fields[7],
 147                     date                   => $fields[8],
 148                     genre                  => $fields[9],
 149                     tracknumber            => $fields[10],
 150                     title                  => $fields[11]};
 151         if ($fields[19]) { #
 152                 $info->{'artist'}              = $fields[12];
 153                 $info->{'totaltracks'}         = $fields[13];
 154                 $info->{'playback_time'}       = $fields[14];
 155                 $info->{'length'}              = $fields[15];
 156
 157                 $info->{'_foobar2000_version'} = $fields[16];
 158
 159                 $info->{'codec_profile'}       = $fields[17];
 160
 161                 $info->{'discnumber'}          = $fields[18];
 162                 $info->{'totaldiscs'}          = $fields[19];
 163         }
 164
 165         $info->{'isplaying'} = 1;
 166         $info->{'ispaused'} = 0;
 167         if ($info->{'state'} eq "113") {
 168                 $info->{'ispaused'} = 1;
 169         } elsif ($info->{'state'} eq "112") {
 170                 $info->{'isplaying'} = 0;
 171         }
 172         delete $info->{'state'};
 173
 174         for (keys %$info) {
 175                 delete $info->{$_} if (defined($info->{$_}) and $info->{$_} eq '?');
 176         }
 177
 178         $info->{'album artist'} = $info->{'artist'} unless defined($info->{'album artist'});
 179         $info->{'track artist'} = $info->{'artist'} if (defined($info->{'artist'}) and $info->{'album artist'} ne $info->{'artist'});
 180
 181         if (defined($info->{'length'})) {
 182                 my ($h, $m, $s) = split(/\:/, $info->{'length'});
 183                 if (defined $s) {
 184                         $info->{'length_seconds'} = $s + $m * 60 + $h * 3600;
 185                 } else {
 186                         $info->{'length_seconds'} = $m + $h * 60;
 187                 }
 188         }
 189
 190         if ($info->{'length_seconds'} and $info->{'playback_time_seconds'}) {
 191                 $info->{'playback_time_remaining_seconds'} =
 192                                 $info->{'length_seconds'} - $info->{'playback_time_seconds'};
 193         }
 194
 195         for (('playback_time', 'playback_time_remaining')) {
 196                 unless (defined($info->{$_})) {
 197                         my $t = $info->{"${_}_seconds"};
 198
 199                         my @u = (0,0);
 200                         for (my $i = 1; $i >= 0; $i--) {
 201                                 $u[$i] = $t % 60;
 202                                 $t = int($t / 60);
 203                         }
 204                         $info->{$_} = sprintf("%s%02d:%02d", $t > 0 ? "$t:" : "", @u[0,1]);
 205                 }
 206         }
 207
 208         return $info;
 209 }
 210
 211 sub parse_format {
 212         my ($format, $info, $sublevel) = @_;
 213         $sublevel = 0 if not defined $sublevel;
 214
 215         my $output = "";
 216
 217         $format =~ s/\R//g; # ignore line breaks
 218         my @chars = split(//,$format);
 219
 220         # Language Definition
 221
 222         # lowercasestring      <== should be parsed as a tag name, makes the expression fail if such tag is not defined
 223         # []                   <== brackets allow the parsing inside them to fail
 224         # $func(arg1,arg2,...) <== function call (see parse_subfunction for details)
 225         # ''                   <== string literal (ignores all parsing)
 226         # \(character)         <== literal character
 227
 228         # Bracket Nesting
 229
 230         # A bracket returns a defined value only if it has at least one tag or at least one of its embedded brackets return true.
 231
 232         my @tokens = ();
 233         my $tagcount = 0;
 234         my $fail = 0;
 235
 236         my $literal = 0;
 237         my $sub = 0;
 238         my $func = 0;
 239         my $tagmode = 0;
 240         my $str = "";
 241         my $ignore = 0;
 242
 243         for(my $i = 0; $i < @chars; $i++ ) { # 1st Pass (Lexical analysis, push into @tokens)
 244                 if($literal) { # If on literal mode
 245                         $str .= $chars[$i]; # Simply copy everything as-is until an unescaped ' is found
 246                         if ($chars[$i] eq "'") {
 247                                 push @tokens, $str;
 248                                 $str = "";
 249                                 $literal = 0;
 250                         } elsif (not defined($chars[$i+1])) { # This means we ended the string with an uneven number of unescaped 's
 251                                 warn "Malformed: mismatched ': $str";
 252                                 return undef;
 253                         }
 254                 } elsif ($sub) { # If on subexpression mode
 255                         $str .= $chars[$i]; # Copy everything as-is until an unescaped ] is found
 256                         if ($chars[$i] eq "'") {
 257                                 $ignore = !$ignore;
 258                         } elsif ($chars[$i] eq "[") { # We must copy any sub-subexpressions inside this sub-expression for recursive evaluation
 259                                 ++$sub unless $ignore;
 260                         } elsif ($chars[$i] eq "]" and !$ignore and --$sub == 0) {
 261                                 push @tokens, $str;
 262                                 $str = "";
 263                         } elsif (not defined($chars[$i+1])) { # This means we ended the string without $sub being 0
 264                                 warn "Malformed: mismatched [: $str";
 265                                 return undef;
 266                         }
 267                 } elsif ($tagmode) { # If on tag mode
 268                         $str .= $chars[$i]; # Copy tags as-is until any % character is found
 269                         if ($chars[$i] eq '%') {
 270                                 push @tokens, $str;
 271                                 $str = "";
 272                                 $tagmode = 0;
 273                         } elsif (not defined($chars[$i+1])) {
 274                                 warn "Malformed: mismatched %: $str";
 275                                 return undef;
 276                         }
 277                 } elsif ($func) { # If on function mode
 278                         $str .= $chars[$i]; # Copy everything until an unescaped ) is found
 279                         if ($chars[$i] eq "'") {
 280                                 $ignore = !$ignore;
 281                         } elsif ($chars[$i] eq "(") {
 282                                 $func++ unless $ignore;
 283                         } elsif ($chars[$i] eq ")" and !$ignore and --$func <= 1) {
 284                                 push @tokens, $str;
 285                                 $str = "";
 286                                 $func = 0;
 287                         } elsif (not defined($chars[$i+1])) {
 288                                 warn "Malformed: mismatched (: $str";
 289                                 return undef;
 290                         }
 291                 } else {
 292                         if ($chars[$i] eq "'") {
 293                                 push @tokens, "$str" if $str ne ""; # Found an opening quote
 294                                 $str = $chars[$i];
 295                                 $literal = 1; # Enter literal mode
 296                         } elsif ($chars[$i] eq "[") {
 297                                 push @tokens, "$str" if $str ne ""; # Found a subexpression opener
 298                                 $str = $chars[$i];
 299                                 $sub = 1; # Enter subexpression mode
 300                         } elsif ($chars[$i] eq "\$") {
 301                                 push @tokens, "$str" if $str ne "";
 302                                 $str = $chars[$i];
 303                                 $func = 1; # Enter subfunction mode
 304                         } elsif ($chars[$i] eq "%") {
 305                                 push @tokens, "$str" if $str ne ""; # Found a tag name
 306                                 $str = $chars[$i];
 307                                 $tagmode = 1; # Enter tag mode
 308                         } else {
 309                                 $str .= $chars[$i]; # Copy as a literal
 310                         }
 311                 }
 312         }
 313
 314         push @tokens, "$str" if $str ne ""; # Make sure whatever is left from parsing is added as a literal
 315
 316         foreach my $token (@tokens) { # 2nd Pass, execute tokens
 317                 if ($token =~ /^'(.*)'$/ or $token =~ /^([^['%\$].*)$/) { # If the token is a literal, then
 318                         $output .= $token eq "''" ? "'" : $1; # '' means a literal ', otherwise literal contents
 319                 } elsif ($token =~ /^%(.*)%$/) { # If this is a tag
 320                         $token = $1;
 321                         return undef unless defined($info->{$token});
 322                         $output .= $info->{$token}; # Copy value to output
 323                 } elsif ($token =~ /^\[(.*)\]$/) { # If the token is a subexpression
 324                         $token = $1;
 325                         my $recurse = parse_format($token, $info, $sublevel+1); # Recurse
 326                         $output .= $recurse if defined($recurse);
 327                 } elsif ($token =~ /^\$/) { # If the token is a subfunction
 328                         my $res = parse_subfunction($token, $info, $sublevel);
 329                         return undef unless defined($res);
 330                         $output .= $res;
 331                 } else {
 332                         warn "Parsing error: $token";
 333                         return undef;
 334                 }
 335         }
 336
 337         return $output;
 338 }
 339
 340 sub build_output {
 341         my ($format, $info, $sublevel) = @_;
 342         $sublevel = 0 if not defined $sublevel;
 343
 344         return parse_format($format, $info, $sublevel);
 345 }
 346
 347 sub parse_subfunction {
 348         my ($function, $info, $sublevel) = @_;
 349
 350         $function =~ /^\$(.*?)\((.*)\)$/;
 351
 352         my $func = $1;
 353
 354         my @rawargs = split(//, $2);
 355         my @args = ();
 356
 357         my $ignore = 0;
 358         my $str = "";
 359         for(my $i = 0; $i < @rawargs; $i++) {
 360                 if ($rawargs[$i] eq "'") {
 361                         $ignore = !$ignore;
 362                 } elsif ($rawargs[$i] eq ",") {
 363                         unless ($ignore) {
 364                                 push @args, $str;
 365                                 $str = "";
 366                                 ++$i;
 367                         }
 368                 }
 369                 $str .= $rawargs[$i] if defined($rawargs[$i]);
 370         }
 371         push @args, $str;
 372
 373         for (my $i = 0; $i < @args; $i++) {
 374                 $args[$i] = parse_format($args[$i], $info, $sublevel+1);
 375         }
 376
 377         if ($func eq "len") {
 378                 return defined $args[0] ? length($args[0]) : undef;
 379         } elsif ($func eq "repeat") {
 380                 return (defined $args[0] and defined $args[1]) ? ($args[0] x $args[1]) : undef;
 381         } elsif ($func eq "trim") {
 382                 my ($str) = @args;
 383                 return undef unless defined $str;
 384                 $str =~ /^\s*+(.*?)\s*+$/;
 385                 return $1;
 386         } elsif ($func eq "put" or $func eq "puts") {
 387                 my ($var, $val) = @args;
 388                 return undef unless (defined $var and defined $val);
 389                 $heap{$var} = $val;
 390                 return ($func eq "put") ? $val : "";
 391         } elsif ($func eq "get") {
 392                 my ($var) = @args;
 393                 return undef unless defined $var;
 394                 return exists $heap{$var} ? $heap{$var} : "";
 395         } elsif ($func eq "pad" or $func eq "pad_right" or $func eq "left" or $func eq "cut" or $func eq "padcut" or $func eq "padcut_right") {
 396                 my ($str, $maxlen, $char) = @args;
 397                 return undef unless (defined $str and $maxlen);
 398
 399                 my $pad = ($func eq "pad" or $func eq "pad_right" or $func eq "padcut" or $func eq "padcut_right");
 400                 my $cut = ($func eq "left" or $func eq "cut" or $func eq "padcut" or $func eq "padcut_right");
 401
 402                 if ($cut) {
 403                         $str = substr($str, 0, $maxlen);
 404                 }
 405                 if ($pad) {
 406                         $char = " " unless defined $char and $char ne "";
 407                         $char = substr($char, 0, 1);
 408                         $str .= ($char x ($maxlen - length($str)));
 409                 }
 410                 return $str;
 411         } elsif ($func eq "right") {
 412                 my ($str, $maxlen) = @args;
 413                 return undef unless (defined $str and defined $maxlen);
 414                 return substr($str, -$maxlen);
 415         } elsif ($func eq "insert" or $func eq "replace") {
 416                 my ($haystack, $needle, $pos) = @args;
 417                 return undef unless (defined($haystack) and defined($needle) and defined($pos));
 418                 if ($func eq "insert") {
 419                         return substr($haystack, 0, $pos) . $needle . substr($haystack, $pos);
 420                 }
 421                 $needle = quotemeta($needle);
 422                 $haystack =~ s/$needle/$pos/g;
 423                 return $haystack;
 424         } elsif ($func eq "if" or $func eq "if2") {
 425                 my ($test, $iftrue, $iffalse);
 426                 if ($func eq "if") {
 427                         ($test, $iftrue, $iffalse) = @args;
 428                 } else {
 429                         ($test, $iffalse) = @args;
 430                         $iftrue = $test;
 431                 }
 432
 433                 if ($test) {
 434                         return $iftrue;
 435                 } else {
 436                         return $iffalse;
 437                 }
 438         } elsif ($func eq "if3") {
 439                 foreach (@args) {
 440                         return $_ if $_;
 441                 }
 442                 return undef;
 443         } elsif ($func eq "greater") {
 444                 my ($arg1, $arg2) = @args;
 445                 return undef unless (defined($arg1) or defined($arg2));
 446                 return $arg1 unless defined $arg2;
 447                 return $arg2 unless defined $arg1;
 448                 return $arg1 if $arg1 >= $arg2;
 449                 return $arg2;
 450         } elsif ($func eq "longer") {
 451                 my ($arg1, $arg2) = @args;
 452                 return undef unless (defined($arg1) or defined($arg2));
 453                 return $arg1 unless defined $arg2;
 454                 return $arg2 unless defined $arg1;
 455                 return $arg1 if length($arg1) >= length($arg2);
 456                 return $arg2;
 457         } elsif ($func eq "longest") {
 458                 return undef unless scalar(@args);
 459                 my $longest = $_[0];
 460                 foreach (@args) {
 461                         next unless defined;
 462                         $longest = $_ if length($_) > length($longest);
 463                 }
 464                 return $longest;
 465         } elsif ($func eq "ifgreater" or $func eq "ifequal" or $func eq "iflonger") {
 466                 my ($arg1, $arg2, $iftrue, $iffalse) = @args;
 467
 468                 unless (defined($arg2)) {
 469                         return $iftrue if (defined($arg1));
 470                         return $iffalse;
 471                 }
 472                 return $iffalse unless (defined($arg1));
 473
 474                 if ($func eq "iflonger") {
 475                         return defined($arg1) ? $iftrue : $iffalse unless (defined($arg1) and defined($arg2));
 476                         return $iftrue if (length($arg1) > length(" " x $arg2));
 477                 } elsif ($func eq "ifequal") {
 478                         # Any of the args may not be comparable, return false in that case
 479                         return $iftrue if (defined($arg1) and defined($arg2));
 480                         return $iffalse unless (defined($arg1) and defined($arg2));
 481                         eval { return $iftrue if $arg1 == $arg2 };
 482                 } else { # ifgreater
 483                         return defined($arg1) ? $iftrue : $iffalse unless (defined($arg1) and defined($arg2));
 484                         eval { return $iftrue if $arg1 > $arg2 };
 485                 }
 486                 return $iffalse;
 487         } elsif ($func eq "abbr") {
 488                 my ($arg1, $arg2) = (0,0);
 489                 $arg1 = $args[0];
 490                 $arg2 = $args[1] if (defined($args[1]));
 491                 return undef unless (defined $arg1 and $arg2 >= 0);
 492
 493                 if (length($arg1) > $arg2) {
 494                         my $abbr = "";
 495                         my @tokens = split(/\s+/, $arg1);
 496                         foreach my $token (@tokens) {
 497                                 my @chars = split(//, $token);
 498                                 $abbr .= $chars[0];
 499                         }
 500                         return $abbr;
 501                 }
 502                 return $arg1;
 503         } elsif ($func eq "num") {
 504                 my ($arg1, $arg2) = @args;
 505                 return undef unless (defined($arg1) and $arg2 > 0);
 506                 return sprintf("%0${arg2}d", $arg1);
 507         } elsif ($func =~ /^(add|sub|mul|div|mod|max|min)$/) {
 508                 my ($arg1, $arg2) = @args;
 509                 return undef unless (defined($arg1) and defined($arg2));
 510                 # Make sure both are numbers. Better way to do this?
 511                 return undef unless eval { $arg1 != $arg2 or $arg1 == $arg2 };
 512                 return $arg1 + $arg2 if ($func eq "add");
 513                 return $arg1 - $arg2 if ($func eq "sub");
 514                 return $arg1 * $arg2 if ($func eq "mul");
 515                 return $arg1 / $arg2 if ($func eq "div");
 516                 return $arg1 % $arg2 if ($func eq "mod");
 517                 return ($arg1 >= $arg2 ? $arg1 : $arg2) if ($func eq "max");
 518                 return ($arg1 < $arg2 ? $arg1 : $arg2) if ($func eq "min");
 519         } elsif ($func =~ /^(and|or|xor|not)$/) {
 520                 my ($arg1, $arg2) = @args;
 521                 $arg1 = 0 unless defined $arg1;
 522                 $arg2 = 0 unless defined $arg2;
 523
 524                 # Need to give explicit returns to avoid eating on parse_format
 525
 526                 return ($arg1 ? 0 : 1) if ($func eq "not");
 527                 return (($arg1 && $arg2) ? 1 : 0) if ($func eq "and");
 528                 return (($arg1 || $arg2) ? 1 : 0) if ($func eq "or");
 529                 return (($arg1 && !$arg2) ? 1 : ((!$arg1 && $arg2) ? 1 : 0)) if ($func eq "xor");
 530         } elsif ($func eq "strcmp" or $func eq "stricmp") {
 531                 my ($arg1, $arg2) = @args;
 532                 return undef unless (defined($arg1) and defined($arg2));
 533                 return ((lc($arg1) eq lc($arg2)) ? 1 : 0) if ($func eq "stricmp");
 534                 return (($arg1 eq $arg2) ? 1 : 0);
 535         } elsif ($func eq "caps") {
 536                 my ($arg1) = @args;
 537                 return undef unless defined $arg1;
 538                 $arg1 =~ s/\b(\S)(\S*)\b/@{[uc($1)]}@{[lc($2)]}/g;
 539                 return $arg1;
 540         } elsif ($func eq "caps2") {
 541                 my ($arg1) = @args;
 542                 return undef unless defined $arg1;
 543                 $arg1 =~ s/\b(\S)/@{[uc($1)]}/g;
 544                 return $arg1;
 545         } elsif ($func eq "fix_eol") {
 546                 my ($meta, $repl) = @args;
 547                 $repl = " (...)" unless $repl;
 548                 return undef unless defined($meta);
 549                 $meta =~ s/\010?\013.*//;
 550                 return $meta;
 551         }
 552
 553         warn "Unknown or unimplemented function: $function";
 554         return undef;
 555 }
 556
 557 sub get_np_string {
 558         my $info = get_track_info();
 559         $info->{comment} = $_[0] if $_[0];
 560         if (defined($info)) {
 561                 return build_output($format, $info);
 562         }
 563         return undef;
 564 }
 565
 566 sub get_help_string {
 567         my $fields;
 568         if (HAVE_IRSSI) {
 569                 $fields = '%%codec%%|||%%bitrate%%|||%%album artist%%|||%%album%%|||%%date%%|||%%genre%%|||%%tracknumber%%|||%%title%%|||%%artist%%|||%%totaltracks%%|||%%playback_time%%|||%%length%%|||%%_foobar2000_version%%|||%%codec_profile%%|||%%discnumber%%|||%%totaldiscs%%';
 570         } else {
 571                 $fields = '%codec%|||%bitrate%|||%album artist%|||%album%|||%date%|||%genre%|||%tracknumber%|||%title%|||%artist%|||%totaltracks%|||%playback_time%|||%length%|||%_foobar2000_version%|||%codec_profile%|||%discnumber%|||%totaldiscs%';
 572         }
 573         my $help = <<EOF
 574 Required Plugin: foo_controlserver
 575 URL: http://www.hydrogenaudio.org/forums/index.php?showtopic=38114
 576 Required settings: Control Server tab:
 577 * Server Port: 3333
 578 * UTF-8 output/input: checked
 579 * Base delimiter: |||
 580 Recommended setting:
 581 * Number of Clients: Some big number like 700
 582 * Fields: $fields
 583
 584 NOTE: the script only works with either the default or this custom Fields line.
 585
 586 This script can also work via SSH tunneling, by using -R 3333:localhost:3333.
 587
 588 EOF
 589 ;
 590         return $help;
 591 }
 592
 593 sub get_intro_string {
 594         my $intro = <<EOF
 595 \002-----------------------------------------------------------------
 596 \002foo_spam - prints the currently playing track from foobar2000
 597 \002Created by Kovensky \(irc.rizon.net #shameimaru\)
 598 This script requires a properly configured foobar2000.
 599 Run /foo_help for help setting foobar2000 up.
 600 \002-----------------------------------------------------------------
 601 Usage:
 602 /aud        - prints the playing song as an ACTION
 603 /np         - alias to /aud
 604 /foo_help   - explains how to set up foobar2000
 605 /foo_format - explains how to set up the output format
 606 \002-----------------------------------------------------------------
 607
 608 EOF
 609 ;
 610         return $intro;
 611 }
 612
 613 sub get_foo_format_help_string {
 614         my $help = <<EOF
 615 Format Definition
 616 Example: %artist% - [%album% - ]%title%
 617
 618 foo_spam now uses the same syntax as foobar2000 (title format), however only
 619 a subset of it is currently implemented. To see the list of supported
 620 tags, use /foo_tags. To see the list of supported functions, use
 621 /foo_funcs.
 622
 623 To change the format, you can use:
 624  * Irssi: /set foo_format <new format> (use /set -default to reset)
 625  * X-Chat: /set_foo_format <new format> (use /set_foo_format default to reset)
 626  * WeeChat: /set foo_spam.settings.format <new format> (use /unset to reset)
 627 You can also edit the script and change the value of \$default_format, in case
 628 you use an unsupported client.
 629
 630 Default: $default_format
 631
 632 EOF
 633 ;
 634         return $help;
 635 }
 636
 637 sub get_taglist_string {
 638         my $list = <<EOF
 639 List of available tags (refer to foobar2000's documentation for their meanings):
 640  - %isplaying%, %ispaused%, %_foobar2000_version%
 641  - %playback_time%, %playback_time_remaining%, %length% (plus the _seconds variants)
 642  - %artist%, %album artist%, %track artist%, %album%, %title%, %genre%
 643  - %date%, %discnumber%, %totaldiscs%, %tracknumber%, %totaltracks%
 644  - %codec%, %bitrate%, %codec_profile%
 645 The %comment% tag is set by foo_spam itself and it contains all arguments that the user gives to /aud in a single string.
 646 EOF
 647 ;
 648         return $list;
 649 }
 650
 651 sub get_funclist_string {
 652         my $list = <<'EOF'
 653 List of available functions (refer to foobar2000's documentation for their meanings):
 654  - $if(X,Y,Z), $if2(X,Y), $ifgreater(A,B,C,D), $iflonger(A,B,C,D), $ifequal(A,B,C,D)
 655  - $and(X,Y), $or(X,Y), $xor(X,Y), $not(X)
 656  - $strcmp(X,Y), $stricmp(X,Y), $len(X), $num(X,Y)
 657  - $caps(X), $caps2(X)
 658  - $trim(A), $pad(X,Y), $pad_right(X,Y), $pad(X,Y,Z), $pad_right(X,Y,Z), $left(X,Y), $cut(X,Y), $padcut(X,Y), $padcut_right(X,Y), $right(X,Y)
 659  - $insert(A,B,N), $replace(A,B,C), $repeat(X,N)
 660  - $abbr(X), $abbr(X,Y)
 661  - $add(X,Y), $sub(X,Y), $mul(X,Y), $div(X,Y), $mod(X,Y), $min(X,Y), $max(X,Y)
 662  - $put(name,text), $puts(name,text), $get(name)
 663 EOF
 664 ;
 665         return $list;
 666 }
 667
 668 if (HAVE_IRSSI) {
 669         *print_now_playing = sub {
 670                 my ($data, $server, $witem) = @_;
 671                 my $str = get_np_string(decode("UTF-8", $data));
 672                 if (defined($str)) {
 673                         if ($witem && ($witem->{type} eq "CHANNEL" ||
 674                                 $witem->{type} eq "QUERY")) {
 675                                 $witem->command(encode_utf8("me $str"));
 676                         }
 677                 }
 678         };
 679
 680         *print_foo_help = sub{
 681                 Irssi::print(get_help_string());
 682         };
 683
 684         *print_foo_format_help = sub {
 685                 my $help = get_foo_format_help_string();
 686                 $help =~ s/%/%%/g;
 687                 Irssi::print($help);
 688         };
 689
 690         *irc_print = sub {
 691                 Irssi::print($_[0]);
 692         };
 693
 694         *print_foo_tags = sub {
 695                 my $help = get_foo_taglist_string();
 696                 $help =~ s/%/%%/g;
 697                 Irssi::print($help);
 698         };
 699
 700         *print_foo_funcs = sub {
 701                 Irssi::print(get_funclist_string());
 702         };
 703
 704         Irssi::settings_add_str("foo_spam", "foo_format", $format);
 705         $format = Irssi::settings_get_str("foo_format");
 706
 707         Irssi::command_bind('aud', 'print_now_playing');
 708         Irssi::command_bind('np', 'print_now_playing');
 709         Irssi::command_bind('foo_help', 'print_foo_help');
 710         Irssi::command_bind('foo_format','print_foo_format_help');
 711         Irssi::command_bind('foo_tags','print_foo_tags');
 712         Irssi::command_bind('foo_funcs','print_foo_funcs');
 713 } elsif (HAVE_XCHAT) {
 714         *print_now_playing = sub {
 715                 my $str = get_np_string($_[0][1] ? $_[1][1] : undef);
 716                 if (defined($str)) {
 717                         Xchat::command(encode_utf8("me $str"));
 718                 }
 719                 return Xchat::EAT_ALL();
 720         };
 721
 722         *print_foo_help = sub {
 723                 Xchat::print(get_help_string());
 724                 return Xchat::EAT_ALL();
 725         };
 726
 727         *irc_print = sub {
 728                 Xchat::print(@_);
 729         };
 730
 731         *set_foo_format = sub {
 732                 if (defined($_[0][1])) {
 733                         open($setting_file, ">", Xchat::get_info('xchatdir') . "/foo_spam.conf");
 734                         if ($_[0][1] eq "default") {
 735                                 $format = $default_format;
 736                         } else {
 737                                 $format = $_[1][1];
 738                         }
 739                         Xchat::print("Changed format to $format\n");
 740                         if (defined($setting_file)) {
 741                                 print $setting_file $format;
 742                                 close($setting_file);
 743                         } else {
 744                                 Xchat::print("Failed to save settings! Error: $!");
 745                         }
 746                 } else {
 747                         Xchat::print("Current format: $format\n");
 748                 }
 749                 return Xchat::EAT_ALL();
 750         };
 751         if (defined(*set_foo_format)) {} # Silence a warning
 752
 753         *print_foo_format_help = sub {
 754                 Xchat::print(get_foo_format_help_string());
 755                 return Xchat::EAT_ALL();
 756         };
 757
 758         *print_foo_tags = sub {
 759                 Xchat::print(get_taglist_string());
 760                 return Xchat::EAT_ALL();
 761         };
 762
 763         *print_foo_funcs = sub {
 764                 Xchat::print(get_funclist_string());
 765                 return Xchat::EAT_ALL();
 766         };
 767
 768         if (open($setting_file, "<", Xchat::get_info('xchatdir') . "/foo_spam.conf")) {
 769                 my $line = <$setting_file>;
 770                 chomp $line;
 771                 $format = $line if (defined($line) and $line ne "");
 772                 close($setting_file);
 773         }
 774
 775         Xchat::hook_command("np","print_now_playing", {help => "alias to /aud"});
 776         Xchat::hook_command("aud","print_now_playing", {help => "prints your currently playing song on foobar2000 on an ACTION"});
 777         Xchat::hook_command("foo_help","print_foo_help", {help => "explains how to set up foobar2000"});
 778         Xchat::hook_command("set_foo_format","set_foo_format", {help => "displays or changes the current format string"});
 779         Xchat::hook_command("foo_format","print_foo_format_help", {help => "explains how to configure the format string"});
 780         Xchat::hook_command("foo_tags","print_foo_tags", {help => "lists all available tags"});
 781         Xchat::hook_command('foo_funcs','print_foo_funcs', {help => "lists all available functions"});
 782 } elsif (HAVE_WEECH) {
 783         *print_now_playing = sub {
 784                 my ($data, $buffer, @args) = @_;
 785                 my $str = get_np_string($args[0] ? decode("UTF-8", join(' ', @args)) : undef);
 786                 if (defined($str)) {
 787                         weechat::command($buffer, encode_utf8("/me $str"));
 788                 }
 789                 return weechat::WEECHAT_RC_OK_EAT();
 790         };
 791
 792         *irc_print = sub {
 793                 weechat::print('', shift);
 794         };
 795
 796         *print_foo_help = sub {
 797                 irc_print(get_help_string());
 798                 return weechat::WEECHAT_RC_OK_EAT();
 799         };
 800
 801         our $config;
 802
 803         *set_foo_format = sub {
 804                 my ($data, $opt) = @_;
 805                 $format = weechat::config_string($opt);
 806                 weechat::config_write($config);
 807                 return weechat::WEECHAT_RC_OK_EAT();
 808         };
 809
 810         *print_foo_format_help = sub {
 811                 irc_print(get_foo_format_help_string());
 812                 return weechat::WEECHAT_RC_OK_EAT();
 813         };
 814
 815         *print_foo_tags = sub {
 816                 irc_print(get_taglist_string());
 817                 return weechat::WEECHAT_RC_OK_EAT();
 818         };
 819
 820         *print_foo_funcs = sub {
 821                 irc_print(get_funclist_string());
 822                 return Xchat::WEECHAT_RC_OK_EAT();
 823         };
 824
 825         $config = weechat::config_new('foo_spam', '', '');
 826
 827         unless (weechat::config_read($config) and
 828                         ($format = weechat::config_string(weechat::config_get('foo_spam.settings.format')))) {
 829                 my $sect = weechat::config_new_section($config, 'settings', 0, 0,
 830                         '', '', '', '', '', '', '', '', '', '');
 831                 my $opt  = weechat::config_new_option($config, $sect, 'format', 'string',
 832                         'The format used for /aud. See /foo_format for help.', '', '', '',
 833                         $default_format, $default_format, 0, '', '', 'set_foo_format', '', '', '');
 834                 weechat::config_write($config);
 835         }
 836
 837         weechat::hook_command('np', 'alias to /aud', '', '', '%(nicks)', 'print_now_playing', '');
 838         weechat::hook_command('aud', 'prints your currently playing song on foobar2000 on an ACTION', '', '', '%(nicks)', 'print_now_playing', '');
 839         weechat::hook_command('foo_help', 'explains how to set up foobar2000', '', '', '', 'print_foo_help', '');
 840         weechat::hook_command('foo_format', 'explains how to configure the format string', '', '', '', 'print_foo_format_help', '');
 841         weechat::hook_command('foo_tags', 'lists all available tags', '', '', '', 'print_foo_tags', '');
 842         weechat::hook_command('foo_funcs', 'lists all available functions', '', '', '', 'print_foo_funcs', '');
 843 } else {
 844         $| = 1;
 845         binmode (STDERR, ":encoding(utf-8)");
 846         binmode (STDOUT, ":encoding(utf-8)");
 847         *irc_print = sub {
 848                 print (STDERR "@_\n") if @_;
 849         };
 850         $format = join(" ", @ARGV) if $ARGV[0];
 851         my $np = get_np_string();
 852         print "$np\n" if $np;
 853 }
 854
 855 if (HAVE_XCHAT or HAVE_IRSSI or HAVE_WEECH) {
 856         irc_print(get_intro_string());
 857 }
 858