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