soepkiptng_web.lib

   1 ############################################################################
   2 # soepkiptng (c) copyright 2000 Eric Lammerts <eric@lammerts.org>.
   3 ############################################################################
   4 # This program is free software; you can redistribute it and/or modify
   5 # it under the terms of the GNU General Public License, version 2, as
   6 # published by the Free Software Foundation.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program; if not, write to the Free Software
  15 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16
  17 ############################################################################
  18
  19 use Digest::MD5 'md5_hex';
  20
  21 sub can_delete($) {
  22         my ($file) = @_;
  23
  24         return undef unless $conf{allow_delete};
  25         my $dir = $file;
  26         $dir =~ s|[^/]*$||;
  27         return -w $dir || -k $dir && -w $file;
  28 }
  29
  30 sub ids_encode(@) {
  31         my $prev = 0;
  32         my $out = '';
  33         foreach(@_) {
  34                 if($_ > $prev && $_ - $prev <= 26) {
  35                         $out .= chr(ord('A') - 1 + $_ - $prev);
  36                 } elsif($_ < $prev && $prev - $_ <= 26) {
  37                         $out .= chr(ord('a') - 1 + $prev - $_);
  38                 } else {
  39                         if($_ - $prev >= 0 && substr($out, -1) =~ /\d/) {
  40                                 $out .= "+";
  41                         }
  42                         $out .= ($_ - $prev);
  43                 }
  44                 $prev = $_;
  45         }
  46         $out =~ s/(([a-z])\2{3,})/"_" . length($1) . $2/egi;
  47         return $out;
  48 }
  49
  50 sub ids_decode($) {
  51         my ($str) = @_;
  52         my $val = 0;
  53         my @out = ();
  54         $str =~ s/_(\d+)([a-z])/$2x$1/egi;
  55         while($str) {
  56                 if($str =~ s/^([a-z])//) {
  57                         $val -= ord($1) - (ord('a') - 1);
  58                 } elsif($str =~ s/^([A-Z])//) {
  59                         $val += ord($1) - (ord('A') - 1);
  60                 } elsif($str =~ s/^([-+ ]?\d+)//) {
  61                         $val += $1;
  62                 } else {
  63                         die "Invalid id encoding: '$str'\n";
  64                 }
  65                 push @out, $val;
  66         }
  67         return @out;
  68 }
  69
  70
  71 sub print_frame($) {
  72         my ($req) = @_;
  73
  74         my $bframe_args = "cmd=empty";
  75         if(exists $req->{args}->{sval}) {
  76                 $bframe_args = sprintf("cmd=search&stype=%s&sval=%s",
  77                         encurl($req->{args}->{stype}) || "any",
  78                         encurl($req->{args}->{sval}));
  79         } elsif(my $np = get_nowplaying($req->{dbh})) {
  80                 $bframe_args = "cmd=alllist&";
  81                 my $cap;
  82                 if($np->{arid}) {
  83                         $bframe_args .= '&artist_id=' . $np->{arid};
  84                         $cap = "Artist: $np->{artist}";
  85                         if($np->{alid}) { $cap .= "; "; }
  86                 }
  87                 if($np->{alid}) {
  88                         $bframe_args .= '&album_id=' . $np->{alid};
  89                         $cap .= "Album: $np->{album}";
  90                 }
  91                 $bframe_args .= "&cap=" . encurl($cap);
  92         }
  93         print <<EOF;
  94 <html>
  95 <head>
  96 <title>$conf{title}</title>
  97 </head>
  98 <frameset rows="$conf{frameheights}">
  99  <frame name=tframe src="$req->{self}?cmd=playlist" marginwidth="$conf{marginwidth}" marginheight="$conf{marginheight}">
 100  <frame name=bframe src="$req->{self}?$bframe_args" marginwidth="$conf{marginwidth}" marginheight="$conf{marginheight}">
 101 </frameset>
 102 <body $conf{body}>
 103 </body>
 104 </html>
 105 EOF
 106 }
 107
 108 sub print_az_table($$) {
 109         my ($req, $session) = @_;
 110         my ($playlistopts, $editlistopts);
 111
 112         my $sth = $req->{dbh}->prepare("SELECT id,name FROM list ORDER BY name");
 113         $sth->execute;
 114         while($_ = $sth->fetchrow_hashref) {
 115                 $playlistopts .= sprintf("   <option value=%d%s>%s\n", $_->{id},
 116                         $_->{id} == $session->{playlist}? " selected":"", $_->{name});
 117                 $editlistopts .= sprintf("   <option value=%d%s>%s\n", $_->{id},
 118                         $_->{id} == $session->{editlist}? " selected":"", $_->{name});
 119         }
 120
 121         printf <<EOF, $req->{self};
 122 <table cellpadding=2 cellspacing=2>
 123 <tr>
 124  <td id=az nowrap colspan=3>
 125  <a id=az href="%s?cmd=playlist">Refresh</a>&nbsp;&nbsp;
 126  <a id=az href="$req->{self}?cmd=shuffle">Shuffle</a>&nbsp;&nbsp;
 127  <a id=az href="$req->{self}?cmd=lists" target=bframe>Playlists</a>&nbsp;&nbsp;
 128  <a id=az href="$req->{self}?cmd=recent&days=7" target=bframe>Recent</a>/<!--
 129 --><a id=az href="$req->{self}?cmd=recent&days=7&np=1" target=bframe>Never Played</a>/<!--
 130 --><a id=az href="$req->{self}?cmd=recent&days=1000000&limit=100" target=bframe>Last 100</a>&nbsp;&nbsp;
 131  <a id=az href="$req->{self}?cmd=alllist&rand=50" target=bframe>Random</a>&nbsp;&nbsp;
 132  <a id=az href="$req->{self}?cmd=alllist&encoding=^Video" target=bframe>Video</a>&nbsp;&nbsp;
 133 <!-- <a id=az target=_blank href="$req->{self}?cmd=maint">*</a>&nbsp;&nbsp;-->
 134  <a id=az target=bframe href="$req->{self}?cmd=cdda">CD-DA</a>&nbsp;&nbsp;
 135  <a id=az target=bframe href="$req->{self}?cmd=shoutcast">Shoutcast</a>&nbsp;&nbsp;
 136  <a id=az target=bframe href="$req->{self}?cmd=sql">SQL</a>
 137 </tr>
 138 <tr>
 139  <td id=az nowrap>
 140 EOF
 141         foreach('A'..'Z') {
 142                 printf qq|<a id=az href="%s?cmd=%s&artist=%s" target=bframe>%s</a>&nbsp;|,
 143                         $req->{self}, $conf{artistlistcmd}, encurl("^$_"), $_;
 144         }
 145         printf <<EOF, $req->{self}, $conf{artistlistcmd}, encurl("^([^a-zA-Z]|\$)");
 146   <a id=az href="%s?cmd=%s&artist=%s" target=bframe>Other</a>&nbsp;
 147 <br>
 148 EOF
 149         my $sz = $conf{searchformsize} || 10;
 150         print <<EOF;
 151  </td>
 152   <form id=search name=search action="$req->{self}" method=get target=bframe>
 153  <td id=az nowrap>&nbsp;&nbsp;Search:
 154 EOF
 155         printf <<EOF, $req->{args}->{nofocus}? "":"document.search.sval.focus();";
 156   <script>
 157   <!--
 158   function do_onload(){%s}
 159   // -->
 160   </script>
 161 EOF
 162         print <<EOF;
 163    <input type=hidden name=cmd value=search>
 164    <input type=text size=$sz name=sval style="$conf{searchformstyle}">
 165  </td>
 166  <td id=az nowrap>
 167   <select name=stype style="$conf{searchformstyle}" onChange="form.submit()">
 168    <option value=any>Any
 169    <option value=artist>Artist
 170    <option value=title>Title
 171    <option value=album>Album
 172    <option value=lyrics>Lyrics
 173    <option value=filename>Filename
 174    <option value=encoding>Encoding
 175   </select>
 176   <noscript><input type=submit value="Go"></noscript>
 177  </td>
 178  </form>
 179 </tr>
 180 </table>
 181 EOF
 182
 183 #<!--
 184 #<td id=az>Play:</td>
 185 #<td id=az>
 186 #  <form id=search action="$req->{self}" method=get target=tframe>
 187 #  <select name=list onChange="">
 188 #   <option value="">All
 189 #$playlistopts
 190 #  </select>
 191 #  <input type=hidden name=cmd value=setplaylist>
 192 #  <input type=submit value="Ok">
 193 #  </form>
 194 #</td>
 195 #
 196 #<td id=az>Edit:</td>
 197 #<td id=az>
 198 #  <form id=search action="$req->{self}" method=get target=tframe>
 199 #  <select name=list onChange="">
 200 #   <option value="">
 201 #$editlistopts
 202 #  </select>
 203 #  <input type=hidden name=cmd value=seteditlist>
 204 #  <input type=submit value="Ok">
 205 #  </form>
 206 #</td>
 207 #
 208 #<td id=az>&nbsp;&nbsp;
 209 #<a id=a target=bframe href="$req->{self}?cmd=lists">Playlists</a>
 210 #</td>
 211 #-->
 212 }
 213
 214 sub table_entry($$;$$$$) {
 215         my ($req, $q, $col1, $title_href, $ids, $extra) = @_;
 216
 217         my $furl = $q->{filename};
 218         $furl =~ s|.*/||;
 219         $furl = $req->{self} . "/" . encurl($furl);
 220         $furl =~ s|//+|/|g;
 221         return sprintf <<EOF,
 222  <tr>
 223   <td %s>&nbsp;%s&nbsp;</td>
 224   <td %s>&nbsp;%s&nbsp;</td>
 225   <td %s>&nbsp;%s&nbsp;</td>
 226   <td %s>&nbsp;%s&nbsp;</td>
 227   <td %s>&nbsp;%s%s%s&nbsp;</td>
 228   <td %s>&nbsp;%s&nbsp;</td>
 229   <td %s>&nbsp;%s&nbsp;</td>
 230   <td %s nowrap> %s %s</td>
 231   %s
 232  </tr>
 233 EOF
 234                 $conf{td_left}, $col1,
 235                 $conf{td_artist},
 236                 $q->{arid}? sprintf(qq|<a id=a href="%s?cmd=alllist&artist_id=%s&cap=%s" target=bframe>%s</a>|,
 237                         $req->{self}, $q->{arid}, encurl("Artist: $q->{artist}"), enchtml($q->{artist}))
 238                         : enchtml($q->{artist}),
 239                 $conf{td_album},
 240                 $q->{alid}? sprintf(qq|<a id=a href="%s?cmd=alllist&album_id=%s&cap=%s" target=bframe>%s</a>|,
 241                         $req->{self}, $q->{alid}, encurl("Album: $q->{album}"), enchtml($q->{album}))
 242                         : enchtml($q->{album}),
 243                 $conf{td_track}, $q->{track}? "$q->{track}." : "",
 244                 $conf{td_song}, $title_href, enchtml($q->{title}), $title_href? "</a>":"",
 245                 $conf{td_time},
 246                 $q->{length}? sprintf("%d:%02d", $q->{length} / 60, $q->{length} % 60) : "?",
 247                 $conf{td_enc}, enchtml($q->{encoding}, 1),
 248                 $conf{td_edit},
 249                 $ids? sprintf(<<EOF,
 250 <a id=a href="%s?cmd=edit&id=%d&ids=%s" title="Edit" target=%s>*</a>
 251 <a id=a href="%s?cmd=lyrics&id=%d&ids=%s" title="Lyrics" target=%s>L</a>
 252 <a id=a href="%s?cmd=download&id=%d" title="Download">D</a>
 253 EOF
 254                         $req->{self}, $q->{id}, $ids, $conf{edit_target} || 'bframe',
 255                         $req->{self}, $q->{id}, $ids, $conf{edit_target} || 'bframe',
 256                         $furl, $q->{id}
 257                 ) : "",
 258                 $req->{list}? sprintf(<<EOF,
 259 <a id=a href="%s?list_id=%d&ids=%d&pq=%s&cmd=%s" title="%s playlist">%s "%s"</a>
 260 EOF
 261                         $req->{self}, $req->{list}, $q->{id},
 262                                 encurl($req->{cgiquery}->query_string()), ($q->{in_list}?
 263                                         ("delfromlist", "Remove from", "Remove from") :
 264                                         ("addtolist", "Add to", "Add to"),
 265                                 enchtml($req->{list_name}))
 266                 ) : "",
 267                 $extra;
 268 }
 269
 270 sub print_albumlist($$$$) {
 271         my ($req, $albumlist, $sep, $prune) = @_;
 272
 273         my $more = 0;
 274         if($prune) {
 275                 my $al_len_tot = 0;
 276                 foreach(@$albumlist) {
 277                         $_->{al_len} = length($_->{album});
 278                         $al_len_tot += $_->{al_len};
 279                 }
 280                 if($conf{albumlist_length_threshold} > 0 &&
 281                    $al_len_tot >= $conf{albumlist_length_threshold}) {
 282                         my $len_to_cut = $al_len_tot - $conf{albumlist_length_threshold};
 283                         foreach(sort { $a->{random_pref} <=> $b->{random_pref} || $b->{al_len} <=> $a->{al_len} } @$albumlist) {
 284                                 $len_to_cut -= $_->{al_len};
 285                                 $_->{al_len} = -1;
 286                                 $more++;
 287                                 last if $len_to_cut < 0;
 288                         }
 289                 }
 290         }
 291         foreach(@$albumlist) {
 292                 next if $_->{al_len} == -1;
 293                 print $sep if $_ != $albumlist->[0];
 294                 $_->{album} =~ /^([^\$\w]*)(I+\b|IJ|.?)(.*)/;
 295                 printf(qq|<a id=a href="%s?cmd=alllist| .
 296                         qq|&artist_id=%d&album_id=%d&cap=%s">%s<b>%s</b>%s</a> (%d)|,
 297                         $req->{self}, $_->{arid}, $_->{alid},
 298                         encurl("Artist: $_->{artist}; Album: $_->{album}"),
 299                         enchtml($1), enchtml($2 || "?"), enchtml($3), $_->{c});
 300         }
 301         if($more) {
 302                 printf <<EOF,
 303 &nbsp; <a id=a href="%s?cmd=albumlist&artist_id=%d&cap=%s">[%d&nbsp;more...].</a>
 304 EOF
 305                         $req->{self}, $albumlist->[0]->{arid},
 306                         encurl("Artist: $albumlist->[0]->{artist}"), $more;
 307         }
 308 }
 309
 310 sub print_playlist_table($) {
 311         my ($req) = @_;
 312         my $killline;
 313         my $totaltime;
 314
 315         my $query =  "SELECT title,artist.name as artist,album.name as album," .
 316                 "song.id as id, track, length, encoding, queue.user as user," .
 317                 "song.artist_id as arid, song.album_id as alid, filename," .
 318                 "left(filename,1) as f" .
 319                 " FROM song,queue,artist,album WHERE present" .
 320                 " AND song.artist_id=artist.id AND song.album_id=album.id" .
 321                 " AND song.id = queue.song_id ORDER BY queue.song_order";
 322         my $sth = $req->{dbh}->prepare($query);
 323         my $rv = $sth->execute
 324                 or die "can't do sql command: " . $req->{dbh}->errstr;
 325         my @ids;
 326         my @records;
 327         while($_ = $sth->fetchrow_hashref) {
 328                 push @ids, $_->{id};
 329                 push @records, $_;
 330                 $totaltime += $_->{length};
 331         }
 332
 333         if($_ = get_nowplaying($req->{dbh})) {
 334                 if($_->{id} > 0) { unshift @ids, $_->{id}; }
 335
 336                 $killline = table_entry($req, $_,
 337                         sprintf(qq|<a id=a href="%s?cmd=kill&id=%s">%s</a>&nbsp;<a id=a href="%s?cmd=addnext&id=%s">next</a>|,
 338                                 $req->{self}, $_->{id}, $conf{killtext}, $req->{self}, $_->{id}),
 339                         undef,
 340                         ($_->{filename} =~ m|^/|)? ids_encode(@ids) : "",
 341                         "<td>&nbsp;" . (($conf{show_user} && $_->{user})? "($_->{user})":"") . "</td>"
 342                 );
 343                 $totaltime += $_->{length};
 344
 345                 if($conf{title_song}) {
 346                         my $alb = $_->{album};
 347                         if($alb && $_->{track}) { $alb .= "/$_->{track}"; }
 348                         if($alb) { $alb = " [$alb]"; }
 349                         printf <<EOF, enchtml("$_->{artist} - $_->{title}$alb");
 350 <script language="Javascript">
 351 <!--
 352   parent.document.title="%s";
 353 // -->
 354 </script>
 355 EOF
 356                 }
 357         }
 358
 359         my $ids = ids_encode(@ids);
 360         my ($playmode) = $dbh->selectrow_array("SELECT value FROM settings WHERE name='playmode'");
 361         printf <<EOF,
 362 <table border=0 cellspacing=0>
 363  <tr>
 364   <th %s>&nbsp;%s&nbsp;</th>
 365   <th %s>&nbsp;Artist&nbsp;</th>
 366   <th %s>&nbsp;Album&nbsp;</th>
 367   <th %s>&nbsp;#&nbsp;</th>
 368   <th %s>&nbsp;Song&nbsp;</th>
 369   <th %s>&nbsp;Time&nbsp;</th>
 370   <th %s>&nbsp;Encoding&nbsp;</th>
 371   <th %s>&nbsp;&nbsp;</th>
 372  </tr>
 373  <tr><td colspan=7></td></tr>
 374 %s%s
 375 <tr><td colspan=7>%d song%s, total time: %d:%02d<br>
 376 play mode: %s</td></tr>
 377 </table>
 378 EOF
 379                 $conf{th_left}, @ids? sprintf(qq|<a id=a href="%s?cmd=del&ids=%s">| .
 380                         qq|$conf{delalltext}</a>|, $req->{self}, ids_encode(@ids)) : "",
 381                 $conf{th_artist}, $conf{th_album}, $conf{th_track}, $conf{th_song},
 382                 $conf{th_time}, $conf{th_enc}, $conf{th_edit},
 383                 $killline,
 384                 join("", map { table_entry($req, $_, sprintf(
 385                         qq|<a id=a href="%s?cmd=del&ids=%s">%s</a> | .
 386                         qq|<a id=a href="%s?cmd=up&id=%s">%s</a> | .
 387                         qq|<a id=a href="%s?cmd=down&id=%s">%s</a>|,
 388                         $req->{self}, $_->{id}, $conf{deltext},
 389                         $req->{self}, $_->{id}, $conf{uptext},
 390                         $req->{self}, $_->{id}, $conf{downtext}),
 391                         undef, $_->{f} eq '/'? $ids : "",
 392                         ($conf{show_user} && $_->{user})? "<td>&nbsp;(".$_->{user}.")</td>":"")
 393                         } @records),
 394                 scalar @ids, @ids != 1? "s":"", $totaltime / 60, $totaltime % 60,
 395                 join(" / ", map { sprintf qq|<a %s href="%s?cmd=playmode&mode=%d">%s</a>|,
 396                         ($_ == $playmode? 'style="font-weight: bold;"' : ''),
 397                         $req->{self}, $_, $playmodes[$_] } (0..$#playmodes));
 398 }
 399
 400 sub print_artistlist_table($$$@) {
 401         my ($req, $session, $caption, $query, @val) = @_;
 402
 403         my $sth = $req->{dbh}->prepare($query);
 404         my $rv = $sth->execute(@val)
 405                 or die "can't do sql command: " . $req->{dbh}->errstr;
 406         my @artists;
 407         my %albumlist;
 408         while($_ = $sth->fetchrow_hashref()) {
 409                 push @artists, $_->{arid} unless $albumlist{$_->{arid}};
 410                 push @{$albumlist{$_->{arid}}}, $_;
 411         }
 412
 413         print "<center id=hdr>$caption</center>\n";
 414         if(!%albumlist) {
 415                 print "No search results.\n";
 416                 return;
 417         }
 418
 419         printf <<EOF;
 420 <table border=0 cellspacing=0>
 421  <tr>
 422   <th>&nbsp;Artist&nbsp;</th>
 423   <th>&nbsp;Albums&nbsp;</th>
 424  </tr>
 425 EOF
 426         my $res = 0;
 427         foreach(map { $albumlist{$_} } @artists) {
 428                 printf <<EOF,
 429 <tr>
 430  <td valign=top>&nbsp;<a id=a href="%s?cmd=alllist&artist_id=%d&cap=%s">%s</a>&nbsp;</td>
 431  <td valign=top>&nbsp;
 432 EOF
 433                         $req->{self}, $_->[0]->{arid}, encurl("Artist: $_->[0]->{artist}"),
 434                         $_->[0]->{artist};
 435                 print_albumlist($req, $_, ",&nbsp; ", 1);
 436                 printf <<EOF,
 437 &nbsp;</td>
 438 </tr>
 439 EOF
 440                 $res++;
 441         }
 442         print <<EOF;
 443 <tr><td colspan=2>$res search results.</td></tr>
 444 </table>
 445 EOF
 446 }
 447
 448 sub print_seealso_row($$) {
 449         my ($req, $artistid) = @_;
 450
 451         my $query = "SELECT seealso.id1 AS id1, seealso.id2 AS id2, ".
 452                 " artist.name AS artist FROM seealso,artist,song WHERE ".
 453                 " (seealso.id2=? AND seealso.id1=artist.id AND ".
 454                 "  seealso.id1=song.artist_id AND song.present) OR".
 455                 " (seealso.id1=? AND seealso.id2=artist.id AND ".
 456                 "  seealso.id2=song.artist_id AND song.present) ".
 457                 " GROUP BY id1, id2, artist ORDER BY artist";
 458         my $sth = $req->{dbh}->prepare($query);
 459         $sth->execute($artistid, $artistid)
 460                 or die "can't do sql command: " . $req->{dbh}->errstr;
 461         my %seealso;
 462         my @ids;
 463         while($_ = $sth->fetchrow_hashref()) {
 464                 if($_->{id1} == $artistid) {
 465                         push @ids, $_->{id2};
 466                         $seealso{$_->{id2}} = $_->{artist};
 467                 } else {
 468                         push @ids, $_->{id1};
 469                         $seealso{$_->{id1}} = $_->{artist};
 470                 }
 471         }
 472         $sth->finish;
 473         if(@ids) {
 474                 print "See Also: ";
 475                 foreach(@ids) {
 476                         print ",&nbsp; " unless $_ == $ids[0];
 477                         printf qq|<a id=a href="%s?cmd=alllist&artist_id=%s&album=%s&cap=%s">$seealso{$_}</a>|,
 478                                 $req->{self}, $_, encurl('^$'), encurl("Artist: $seealso{$_}; Album: ^\$");
 479                 }
 480                 print ".<br>\n";
 481         }
 482 }
 483
 484 sub print_albums_row($$$$;$) {
 485         my ($req, $baseurl, $artistid, $label, $expand) = @_;
 486
 487         my $query = "SELECT DISTINCT binary album.name as album," .
 488                 " binary artist.name as artist, song.random_pref," .
 489                 " count(*) as c, song.artist_id as arid, song.album_id as alid " .
 490                 " FROM song,artist,album WHERE present AND song.artist_id = ?".
 491                 " AND song.artist_id=artist.id AND song.album_id=album.id".
 492                 " AND filename LIKE '/%'".
 493                 " GROUP BY album ORDER BY album";
 494         $sth = $req->{dbh}->prepare($query);
 495         $sth->execute($artistid)
 496                 or die "can't do sql command: " . $req->{dbh}->errstr;
 497
 498         my $albumlist = $sth->fetchall_arrayref({});
 499         if(@$albumlist == 0) {
 500                 return undef;
 501         }
 502         printf "$label$sep";
 503         print_albumlist($req, $albumlist, $expand? "<br>\n" : ",&nbsp;\n", !$expand);
 504         print "\n";
 505         return 1;
 506 }
 507
 508 sub print_alllist_table($$$@) {
 509         my ($req, $session, $caption, $query, $limit, @val) = @_;
 510         my ($output, $addall);
 511
 512         print <<EOF;
 513 <center id=hdr>$caption</center>
 514 EOF
 515
 516         my $sth = $req->{dbh}->prepare($query . ($limit? " LIMIT $limit":""));
 517         my $rv = $sth->execute(@val)
 518                 or die "can't do sql command: " . $req->{dbh}->errstr;
 519         my @ids;
 520         my %records;
 521         my $totaltime;
 522         my %artistids;
 523         while($_ = $sth->fetchrow_hashref) {
 524                 $records{$_->{id}} = $_;
 525                 push @ids, $_->{id};
 526                 $totaltime += $_->{length};
 527                 $artistids{$_->{arid}}++;
 528         }
 529         if(!@ids) {
 530                 if($req->{args}->{artist_id}) {
 531                         print_seealso_row($req, $req->{args}->{artist_id});
 532                         print_albums_row($req, $baseurl, $req->{args}->{artist_id}, "Albums: ")
 533                                 and return;
 534                 }
 535                 print "No search results.\n";
 536                 return;
 537         }
 538         my $ids = ids_encode(@ids);
 539
 540         my $baseurl = "$req->{self}?";
 541         foreach(keys %{$req->{args}}) {
 542                 next if $_ eq "cmd";
 543                 next if /^add_/;
 544                 $baseurl .= "$_=" . encurl($req->{args}->{$_}) . "&";
 545         }
 546
 547         foreach $id (@ids) {
 548                 $_ = $records{$id};
 549                 my $el = $session->{editlist};
 550                 my $listch;
 551                 if($el) {
 552                         if($req->{dbh}->do("SELECT entity_id FROM list_contents" .
 553                                 " WHERE list_id=? AND (" .
 554                                 "  (type=? AND entity_id=?) OR" .
 555                                 "  (type=? AND entity_id=?) OR" .
 556                                 "  (type=? AND entity_id=?))", undef,
 557                                 $el,
 558                                 "Song", $_->{id},
 559                                 "Artist", $_->{arid},
 560                                 "Album", $_->{alid}) < 1) {
 561                                 $listch = <<EOF;
 562 &nbsp;<a href="${baseurl}cmd=addtolist&add_list=$el&add_type=song&add_id=$_->{id}" target=bframe>+</a>
 563 EOF
 564                         }
 565                 }
 566
 567                 my $thref = sprintf(qq|<a id=a href="%s?cmd=add&ids=%d" target=tframe>|,
 568                         $req->{self}, $_->{id});
 569                 $output .= table_entry($req, $_, "$thref$conf{addtext}</a>", $thref, $ids);
 570         }
 571
 572         if(scalar keys %artistids == 1 && !$req->{args}->{no_artist_rows}) {
 573                 print_seealso_row($req, (keys %artistids)[0]);
 574                 print_albums_row($req, $baseurl, (keys %artistids)[0], "Albums: ");
 575         }
 576
 577         print "<table border=0 cellspacing=0>\n";
 578
 579         my $ids;
 580         if(@ids) {
 581                 $ids = ids_encode(@ids);
 582                 $addall = qq|<a id=a href="$req->{self}?cmd=add&ids=$ids&skipfirstifplaying=1" target=tframe>$conf{addalltext}</a>|
 583         }
 584
 585         my %revsort;
 586         $revsort{$req->{args}->{sort}} = "r_";
 587
 588         my $baseurl = "$req->{self}?";
 589         foreach(keys %{$req->{args}}) {
 590                 next if $_ eq 'sort';
 591                 $baseurl .= "$_=" . encurl($req->{args}->{$_}) . "&";
 592         }
 593
 594         my $res = $#ids + 1;
 595         my $limitstr = '';
 596         $limitstr = " <b>(limit of $limit reached)</b>" if $limit && $res == $limit;
 597         $totaltime = sprintf "%d:%02d:%02d", $totaltime / 3600,
 598                 $totaltime / 60 % 60, $totaltime % 60;
 599         $totaltime =~ s/^0:0?//;
 600         print <<EOF;
 601  <tr>
 602   <th $conf{th_left}>&nbsp;$addall&nbsp;</th>
 603   <th $conf{th_artist}>&nbsp;<a href="${baseurl}sort=$revsort{artist}artist">Artist</a>&nbsp;</th>
 604   <th $conf{th_album}>&nbsp;<a href="${baseurl}sort=$revsort{album}album">Album</a>&nbsp;</th>
 605   <th $conf{th_track}>&nbsp;<a href="${baseurl}sort=$revsort{track}track">#</a>&nbsp;</th>
 606   <th $conf{th_song}>&nbsp;<a href="${baseurl}sort=$revsort{title}title">Song</a>&nbsp;</th>
 607   <th $conf{th_time}>&nbsp;<a href="${baseurl}sort=$revsort{length}length">Time</a>&nbsp;</th>
 608   <th $conf{th_enc}>&nbsp;<a href="${baseurl}sort=$revsort{encoding}encoding">Encoding</a>&nbsp;</th>
 609  </tr>
 610  <tr><td colspan=7></td></tr>
 611 $output
 612 <tr><td colspan=7>$res search results$limitstr, total time: $totaltime</td></tr>
 613 EOF
 614         (my $f = $caption) =~ s/^\w+:\s*//;
 615         $f =~ s~(/|\\|:|;|")+~_~g;
 616         ($f = "$req->{self}/$f.tar") =~ s|//+|/|g;
 617         print <<EOF if $ids;
 618 <tr><td colspan=7><a href="$f?cmd=downloadset&ids=$ids">download all as tar</a></td></tr>
 619 EOF
 620         print <<EOF;
 621 </table>
 622 EOF
 623 }
 624
 625 sub print_edit_page($) {
 626         my ($req) = @_;
 627
 628         my $i = 0;
 629         my @ids = ids_decode($req->{args}->{ids});
 630         foreach(@ids) {
 631                 last if $_ == $req->{args}->{id};
 632                 $i++;
 633         }
 634         my $prev = '&nbsp;&nbsp;&nbsp;&nbsp;';
 635         if($i > 0) {
 636                 $prev = "<input type=submit name=go_$ids[$i-1] value=Prev>";
 637         } elsif($conf{disabled_buttons}) {
 638                 $prev = "<input type=submit name=go_$ids[0] value=Prev disabled>";
 639         }
 640
 641         my $next = $conf{disabled_buttons}? '':'&nbsp;&nbsp;&nbsp;&nbsp;';
 642         if($i < $#ids) {
 643                 $next = "<input type=submit name=go_$ids[$i+1] value=Next>";
 644         } elsif($conf{disabled_buttons}) {
 645                 $next = "<input type=submit name=go_$ids[$#ids] value=Next disabled>";
 646         }
 647
 648         my $sth = $req->{dbh}->prepare("SELECT artist.name as artist,album.name as album," .
 649                 " song.*," .
 650                 " unix_timestamp(last_played) as lp," .
 651                 " unix_timestamp(time_added) as ta" .
 652                 " FROM song,artist,album WHERE song.id=$req->{args}->{id}" .
 653                 " AND song.artist_id=artist.id AND song.album_id=album.id");
 654         $sth->execute()
 655                 or die "can't do sql command: " . $req->{dbh}->errstr;
 656         $_ = $sth->fetchrow_hashref()
 657                 or die sprintf <<EOF,
 658 id %d not found.<br>
 659 <form action="%s" method=get>
 660  <input type=hidden name=id value="%d">
 661  <input type=hidden name=cmd value=changefile>
 662  <input type=hidden name=ids value="%s">
 663
 664 %s %s</form>
 665 EOF
 666                         $req->{args}->{id}, $req->{self},
 667                         $req->{args}->{id}, $req->{args}->{ids},
 668                         $prev, $next;
 669
 670         my $f = $_->{filename};
 671         my ($dir, $file);
 672         if($f =~ m|^(/.*)/(.*?)$|) {
 673                 my $dir2;
 674                 ($dir, $dir2, $file) = ($1, $1, $2);
 675                 $dir2 =~ s/ /_/g;
 676                 $dir2 =~ s/\\/\\\\/g;
 677                 $dir = sprintf qq|<a href="%s?cmd=alllist&sort=artist&filename=%s">%s</a>|,
 678                         $req->{self}, encurl($dir2), enchtml($dir);
 679                 (my $furl = $req->{self} . "/" . encurl($file)) =~ s|//+|/|g;
 680                 $file = sprintf qq|<a href="%s?cmd=download&id=%d">%s</a>|,
 681                         $furl, $req->{args}->{id}, enchtml($file);
 682         } else {
 683                 $file = enchtml($f);
 684                 $dir = "";
 685         }
 686
 687         printf <<EOF,
 688 <script language="Javascript">
 689 <!--
 690 function verifydelete() {
 691    return confirm("Are you sure you want to delete this file?");
 692 }
 693 function verifyall() {
 694    return confirm("Are you sure you want to apply this value to the entire list (%d entries)?");
 695 }
 696 function closethis() {
 697    window.close(self);
 698 }
 699 // -->
 700 </script>
 701
 702 <form action="%s" method=get>
 703  <input type=hidden name=id value="%d">
 704  <input type=hidden name=cmd value=changefile>
 705  <input type=hidden name=ids value="%s">
 706 <table>
 707 <caption>Edit Song</caption>
 708   <tr><td valign=bottom colspan=2>Present:</td><td valign=bottom>%s</td></tr>
 709   <tr><td valign=bottom colspan=2>Artist:</td><td valign=bottom>
 710      <input type=text size=60 name=artist value="%s">
 711      <input type=submit name=action_clear_artist value="Clear">
 712      <input type=submit name=action_fix_artist value="Fix">
 713      <input type=submit name=action_swapa value="Swap first/last">
 714      <input type=submit name=action_all_artist value="Set entire list"
 715       onClick="return verifyall();">
 716   </td></tr>
 717   <tr><td valign=bottom colspan=2>Title:</td> <td valign=bottom>
 718      <input type=text size=60 name=title  value="%s">
 719      <input type=submit name=action_clear_title value="Clear">
 720      <input type=submit name=action_fix_title value="Fix">
 721      <input type=submit name=action_swap value="Swap artist/title">
 722   </td></tr>
 723   <tr><td valign=bottom colspan=2>Album:</td> <td valign=bottom>
 724      <input type=text size=60 name=album  value="%s">
 725      <input type=submit name=action_clear_album value="Clear">
 726      <input type=submit name=action_fix_album value="Fix">
 727      <input type=submit name=action_all_album value="Set entire list"
 728       onClick="return verifyall();">
 729   </td></tr>
 730   <tr><td valign=bottom colspan=2>Track:</td> <td valign=bottom><input type=text size=3 name=track  value="%s" maxlength=3></td></tr>
 731   <tr><td valign=bottom colspan=2>Time:</td>  <td valign=bottom>%s</td></tr>
 732   <tr><td valign=bottom colspan=2>Encoding:</td>        <td valign=bottom>%s</td></tr>
 733   <tr><td valign=bottom colspan=2 nowrap>Time Added:</td><td valign=bottom>%s</td></tr>
 734   <tr><td valign=bottom colspan=2 nowrap>Last played:</td><td valign=bottom>%s%s
 735      <input type=submit name=action_setlpall value=\"Set entire list to current time\"></td></tr>
 736   <tr><td valign=bottom colspan=2 nowrap>Random pref.:</td><td valign=bottom><input type=text size=8 name=random_pref value="%d" maxlength=8>
 737      <input type=submit name=action_setrpall value="Set entire list." onClick="return verifyall();"></td></tr>
 738   <tr><td valign=bottom colspan=2>Directory:</td>       <td valign=bottom>%s</td></tr>
 739   <tr><td valign=bottom colspan=2>Filename:</td>        <td valign=bottom>%s</td></tr>
 740   <tr><td valign=bottom colspan=2>Trim Start:</td>      <td valign=bottom>%s</td></tr>
 741   <tr><td valign=bottom colspan=2>Trim Length:</td>     <td valign=bottom>%s</td></tr>
 742   <tr><td valign=bottom colspan=2>Size:</td>            <td valign=bottom>%dk</td></tr>
 743   <tr><td valign=bottom colspan=2>Volume correction:</td><td valign=bottom>%s</td></tr>
 744   <tr>
 745    <td valign=bottom align=center>%s</td>
 746    <td valign=bottom align=center>%s</td>
 747    <td valign=bottom>
 748     <input type=submit value="Update">&nbsp;&nbsp;
 749 <script language="Javascript">
 750 <!--
 751  document.write('<input type=submit value="Close" onClick="javascript:window.close();">&nbsp;&nbsp;');
 752 // -->
 753 </script>
 754     %s
 755    </td>
 756   </tr>
 757 </table>
 758 </form>
 759 EOF
 760                 $#ids + 1, $req->{self}, $req->{args}->{id}, $req->{args}->{ids},
 761                 $_->{present}? "Yes" : "No",
 762                 enchtml($_->{artist}),
 763                 enchtml($_->{title}),
 764                 enchtml($_->{album}),
 765                 $_->{track} || "",
 766                 $_->{length}? sprintf("%d:%02d", $_->{length} / 60, $_->{length} % 60) : "?",
 767                 $_->{encoding},
 768                 $_->{ta}? scalar localtime($_->{ta}) : "-",
 769                 $_->{lp}? scalar localtime($_->{lp}) : "-",
 770                 $_->{lp}? " <font size=-1><input type=submit name=action_clearlp value=Reset> " .
 771                         "<input type=submit name=action_clearlpall value=\"Reset entire list\"></font>":"",
 772                 $_->{random_pref}, $dir, $file,
 773                 $_->{trimstart}, $_->{trimlength},
 774                 ((-s $_->{filename}) + 512) / 1024,
 775                 defined($_->{gain})? sprintf("%.3fdB", $_->{gain} / 1000) : "-",
 776                 $prev, $next,
 777                 (can_delete($_->{filename})? qq'<input type=submit ' .
 778                   qq'name=action_delete value="Delete Song" ' .
 779                   qq'onclick="return verifydelete();">&nbsp;&nbsp;':'');
 780 }
 781
 782
 783 sub getuseragent()
 784 {
 785         my $ua = new LWP::UserAgent();
 786         $ua->agent('Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.4b) Gecko/20030516 Mozilla Firebird/0.6');
 787
 788         if($conf{http_proxy}) {
 789                 $ua->proxy('http', $conf{http_proxy});
 790         } else {
 791                 $ua->env_proxy();
 792         }
 793
 794         if($conf{no_proxy}) {
 795                 $ua->no_proxy(split /[\s,]+/, $conf{http_proxy});
 796         }
 797         return $ua;
 798 }
 799
 800 sub getlyrics_purelyrics_com($) {
 801         my ($info) = @_;
 802
 803         my $ua = getuseragent();
 804
 805         my $baseurl = "http://www.purelyrics.com/index.php";
 806
 807         my $url = "$baseurl?search_advsubmit2=Search";
 808         $url .= "&search_artist=" . encurl(lc $info->{artist});
 809         $url .= "&search_album=" . encurl(lc $info->{album});
 810         $url .= "&search_title=" . encurl(lc $info->{title});
 811
 812         my $req = HTTP::Request->new(GET => $url);
 813         my $res = $ua->request($req);
 814
 815         if($res->code != 200) {
 816                 $info->{errormsg} = sprintf "%d %s", $res->code, $res->message;
 817                 return undef;
 818         }
 819
 820         if($res->content !~ /^(\d+) matches.*<a href="([^"]+)">/m) {
 821                 $info->{errormsg} = "no matches";
 822                 return undef;
 823         }
 824
 825         my ($num, $url) = ($1, $2);
 826         if($num != 1) {
 827                 $info->{errormsg} = "more than one match";
 828                 return undef;
 829         }
 830
 831         $info->{description} = "http://www.purelyrics.com/$url";
 832         $req = HTTP::Request->new(GET => $info->{description});
 833         $res = $ua->request($req);
 834
 835         if($res->code != 200) {
 836                 $info->{errormsg} = sprintf "%d %s", $res->code, $res->message;
 837                 return undef;
 838         }
 839
 840         foreach(split /\n+/, $res->content) {
 841                 s/^\s+|\s+$|\r+//g;
 842                 if(s/.*<font class="capitalFont">//) {
 843                         $lyr = 1;
 844                 }
 845                 if($lyr) {
 846                         s|<br />|| or $lyr = 0;
 847                         s|<[^>]+>||g;
 848                         s|\s+$||;
 849                         $info->{lyrics} .= "$_\n";
 850                 }
 851         }
 852         return 1;
 853 }
 854
 855 sub getlyrics_lyricsdomain_com($) {
 856         my ($info) = @_;
 857
 858         my $ua = getuseragent();
 859
 860         my $url = "http://www.lyricsdomain.com/src.php?action=+++Search+++";
 861         $url .= "&artist=" . encurl(lc $info->{artist});
 862         $url .= "&query=" . encurl(lc $info->{title});
 863
 864         my $req = HTTP::Request->new(GET => $url);
 865         my $res = $ua->request($req);
 866
 867         if($res->code != 200) {
 868                 $info->{errormsg} = sprintf "%d %s", $res->code, $res->message;
 869                 return undef;
 870         }
 871
 872         if($res->content !~ /Your query generated (\d+) matches.*lyricsdomain\.asp\?cat=(\d+)">/m) {
 873                 $info->{errormsg} = "no matches";
 874                 return undef;
 875         }
 876
 877         my ($num, $lyrnum) = ($1, $2);
 878         if($num != 1) {
 879                 $info->{errormsg} = "more than one match";
 880                 return undef;
 881         }
 882
 883         $info->{description} = "http://www.lyricsdomain.com/lyrics/$lyrnum/";
 884         $req = HTTP::Request->new(GET => $info->{description});
 885         $res = $ua->request($req);
 886
 887         if($res->code != 200) {
 888                 $info->{errormsg} = sprintf "%d %s", $res->code, $res->message;
 889                 return undef;
 890         }
 891
 892         foreach(split /\n+/, $res->content) {
 893                 s/^\s+|\s+$|\r+//g;
 894                 if(/sendlyrics.php/) {
 895                         $lyr = 1;
 896                         next;
 897                 }
 898                 if($lyr) {
 899                         my $stop = 1 if s|</pre>||;
 900                         s|<[^>]+>||g;
 901                         s|\s+$||;
 902                         $info->{lyrics} .= "$_\n";
 903                         last if $stop;
 904                 }
 905         }
 906         return 1;
 907 }
 908
 909 sub lyrics_string_simplify($) {
 910         my ($a) = @_;
 911
 912         $a =~ s/(\d),(\d)/\1\2/g;
 913         $a =~ s/-/ /g;
 914         $a =~ s/[\[(](.*)//;
 915         $a =~ s/[ _]?&[_ ]?/ and /;
 916         $a =~ s/([\x80-\xff])/lc($latin9_to_ascii{ord($1)})/ge;
 917         $a =~ s/[^'A-Za-z0-9]+/ /g;
 918         $a =~ s/\s+/ /g;
 919         $a =~ s/^\s+|\s+$//g;
 920         return lc($a);
 921 }
 922
 923 sub getlyrics($;$) {
 924         my ($info, $try) = @_;
 925
 926         # save artist/title/album
 927         my ($ar, $ti, $al) = ($info->{artist}, $info->{title}, $info->{album});
 928
 929         if($try == 3) {
 930                 $info->{artist} =~ s/'//g;
 931                 $info->{title} =~ s/'//g;
 932                 $info->{album} =~ s/'//g;
 933         }
 934         if($try >= 2) {
 935                 $info->{artist} = lyrics_string_simplify($info->{artist});
 936                 $info->{title} = lyrics_string_simplify($info->{title});
 937                 $info->{album} = lyrics_string_simplify($info->{album});
 938         }
 939         print "<!-- try$try '$info->{artist}', '$info->{title}', '$info->{album}' -->\n";
 940
 941         getlyrics_purelyrics_com($info) || getlyrics_lyricsdomain_com($info);
 942
 943         $info->{lyrics} =~ s/^\s+//;
 944         $info->{lyrics} =~ s/\s+$/\n/g;
 945
 946         # restore artist/title/album
 947         ($info->{artist}, $info->{title}, $info->{album}) = ($ar, $ti, $al);
 948 }
 949
 950 sub print_lyrics_google_redir($) {
 951         my ($req) = @_;
 952
 953         my ($a, $t) = $req->{dbh}->selectrow_array(
 954                         "SELECT artist.name, song.title FROM song " .
 955                         "LEFT JOIN artist ON artist.id=song.artist_id " .
 956                         "WHERE song.id=?", undef, $req->{args}->{id})
 957                 or die "id $req->{args}->{id} not found.\n";
 958
 959         print $req->{cgiquery}->redirect("http://www.google.com/search?q=" .
 960                 encurl("lyrics \"$a\" \"$t\""));
 961 }
 962
 963 sub print_lyrics_page($) {
 964         my ($req) = @_;
 965
 966         if($req->{args}->{action_clear}) {
 967                 $req->{args}->{lyrics} = $req->{args}->{description} = "";
 968         }
 969         if($req->{args}->{action_refetch}) {
 970                 $req->{dbh}->do("DELETE FROM lyrics WHERE id=?", undef, $req->{args}->{id});
 971         }
 972         $req->{args}->{lyrics} =~ s/\r\n?/\n/g;
 973         if($req->{args}->{update}) {
 974                 $req->{dbh}->do("REPLACE INTO lyrics SET id=?, description=?, language=?, lyrics=?",
 975                         undef, $req->{args}->{id}, $req->{args}->{description},
 976                         $req->{args}->{language}, $req->{args}->{lyrics})
 977                         or die;
 978         }
 979
 980         foreach(keys %{$req->{args}}) {
 981                 if(/^go_(\d+)$/) {
 982                         $req->{args}->{id} = $1;
 983                         last;
 984                 }
 985         }
 986         my $sth = $req->{dbh}->prepare(
 987                 "SELECT song.id, title, song.track, album.name as album, " .
 988                 "artist.name as artist, lyrics.lyrics as lyrics, " .
 989                 "lyrics.language as language, lyrics.description as description FROM song " .
 990                 "LEFT JOIN album ON album.id=song.album_id " .
 991                 "LEFT JOIN artist ON artist.id=song.artist_id " .
 992                 "LEFT JOIN lyrics ON lyrics.id=song.id " .
 993                 "WHERE song.id=$req->{args}->{id}");
 994         $sth->execute()
 995                 or die "can't do sql command: " . $req->{dbh}->errstr;
 996         my $f = $sth->fetchrow_hashref() or die "id $req->{args}->{id} not found.\n";
 997
 998         my $downloaded;
 999         if($conf{auto_download_lyrics} && $f->{lyrics} eq "" && !$req->{args}->{action_clear}) {
1000                 getlyrics($f);
1001                 if($f->{lyrics} eq "") { getlyrics($f, 2); }
1002                 if($f->{lyrics} eq "") { getlyrics($f, 3); }
1003
1004                 $downloaded = "<tr><td colspan=2><b>(";
1005                 if($f->{lyrics} eq "") {
1006                         $downloaded .= "No lyrics found";
1007                         $downloaded .= ": $f->{errormsg}" if $f->{errormsg};
1008                         delete $f->{description};
1009                 } else {
1010                         $downloaded .= sprintf "Downloaded lyrics from <a href=\"%s\">%s</a>",
1011                                 $f->{description}, enchtml($f->{description});
1012                 }
1013                 $downloaded .= ")</b></td></tr>";
1014                 $f->{language} = "eng";
1015         }
1016
1017         my $i = 0;
1018         my @ids = ids_decode($req->{args}->{ids});
1019         foreach(@ids) {
1020                 last if $_ == $req->{args}->{id};
1021                 $i++;
1022         }
1023         my $prev = '&nbsp;&nbsp;&nbsp;&nbsp;';
1024         if($i > 0) {
1025                 $prev = "<input type=submit name=go_$ids[$i-1] value=Prev>";
1026         } elsif($conf{disabled_buttons}) {
1027                 $prev = "<input type=submit name=go_$ids[0] value=Prev disabled>";
1028         }
1029
1030         my $next = $conf{disabled_buttons}? '':'&nbsp;&nbsp;&nbsp;&nbsp;';
1031         if($i < $#ids) {
1032                 $next = "<input type=submit name=go_$ids[$i+1] value=Next>";
1033         } elsif($conf{disabled_buttons}) {
1034                 $next = "<input type=submit name=go_$ids[$#ids] value=Next disabled>";
1035         }
1036
1037 #       my $rows = 1 + $f->{lyrics} =~ tr/\n/\n/;
1038 #       if($rows == 1) { $rows = 30; }
1039         $rows = 30;
1040
1041         my $description = $f->{description};
1042         $description =~ s/\s.*//;
1043         if($description =~ /^(ftp|http):/) {
1044                 $description = "<a href=\"$description\" target=_blank>Open page</a>";
1045         } else {
1046                 $description = "";
1047         }
1048
1049         printf <<EOF,
1050 <form action="%s" method=post>
1051  <input type=hidden name=id value="%d">
1052  <input type=hidden name=cmd value=lyrics>
1053  <input type=hidden name=update value=1>
1054  <input type=hidden name=ids value="%s">
1055 <table>
1056 <caption>Edit Song Lyrics</caption>
1057 %s
1058  <tr><td>Artist:</td><td>%s</td></tr>
1059  <tr><td>Title:</td><td>%s</td></tr>
1060  <tr><td>Album:</td><td>%s</td></tr>
1061  <tr><td>Track:</td><td>%s</td></tr>
1062  <tr>
1063   <td>Description:</td>
1064   <td><input type=text name=description size=74 value="%s">%s</td>
1065  </tr>
1066  <tr>
1067   <td>Language:</td>
1068   <td><select name=language>%s</select></td></tr>
1069  </tr>
1070  <tr><td colspan=2><textarea name=lyrics cols=90 rows=%d>%s</textarea></td></tr>
1071  <tr>
1072   <td colspan=2>%s %s
1073    <input type=submit name=action_update value="Update">
1074    <input type=submit name=action_clear value="Clear">
1075    <input type=submit name=action_refetch value="Refetch">
1076 <script language="Javascript">
1077 <!--
1078  document.write('<input type=submit value="Close" onClick="javascript:window.close();">');
1079 // -->
1080 </script>
1081 </form>
1082   </td>
1083  </tr>
1084  <tr>
1085   <td colspan=2>
1086    <form action="%s" method=get target=_blank>
1087     <input type=submit value="Google for lyrics">
1088     <input type=hidden name=id value="%d">
1089     <input type=hidden name=cmd value=googlelyrics>
1090    </form>
1091   </td>
1092  </tr>
1093 </table>
1094 EOF
1095                 $req->{self}, $req->{args}->{id}, $req->{args}->{ids}, $downloaded,
1096                 enchtml($f->{artist}), enchtml($f->{title}),
1097                 enchtml($f->{album}), $f->{track}? $f->{track} : "",
1098                 enchtml($f->{description}), $description,
1099                 join("\n", map { sprintf "<option value=\"%s\"%s>%s</option>",
1100                                 $_, $_ eq $f->{language}? " selected":"",
1101                                 $_? "$iso_639_2{$_} ($_)" : "-------";
1102                         } (qw/eng dut ger fre esl ita/, '',
1103                                 sort { lc($iso_639_2{$a}) cmp lc($iso_639_2{$b}) }
1104                                 grep { ! /^(eng|dut|ger|fre|esl|ita)$/ } keys %iso_639_2)),
1105                 $rows, enchtml($f->{lyrics}),
1106                 $prev, $next, $req->{self}, $req->{args}->{id};
1107 }
1108
1109 sub print_shoutcast_page($) {
1110         my ($req) = @_;
1111
1112         $req->{args}->{name} =~ s/^\s+|\s+$//g;
1113         $req->{args}->{url} =~ s/^\s+|\s+$//g;
1114         foreach(keys %{$req->{args}}) {
1115                 if(/^delete_(\d+)$/) {
1116                         require_write_access;
1117                         $req->{dbh}->do("DELETE FROM song WHERE id=?", undef, $1)
1118                                 or die "can't do sql command: " . $req->{dbh}->errstr;
1119                         delete $req->{args}->{editid};
1120                         delete $req->{args}->{url};
1121                 }
1122         }
1123         if($req->{args}->{editid} && $req->{args}->{url}) {
1124                 require_write_access;
1125                 if($req->{args}->{action_clear_name}) { $req->{args}->{name} = ""; }
1126                 $req->{dbh}->do("UPDATE song SET title=?,filename=? WHERE id=?",
1127                         undef, $req->{args}->{name}, $req->{args}->{url}, $req->{args}->{editid})
1128                         or die "can't do sql command: " . $req->{dbh}->errstr;
1129         } elsif($req->{args}->{url}) {
1130                 require_write_access;
1131                 my $arid = get_id($req->{dbh}, "artist", '') or die;
1132                 my $alid = get_id($req->{dbh}, "album", '') or die;
1133                 $req->{dbh}->do("REPLACE INTO song SET title=?, filename=?, album_id=?, " .
1134                         "artist_id=?, present=1, encoding='Shoutcast', track=0, " .
1135                         "length=0, time_added=NULL", undef,
1136                         $req->{args}->{name}, $req->{args}->{url}, $alid, $arid) or die;
1137         }
1138
1139         printf <<EOF,
1140 <center id=hdr>Shoutcast Radio Channels</center>
1141 <table border=0 cellspacing=0>
1142  <tr>
1143   <th %s>&nbsp;<a href="%s?cmd=shoutcast">Refresh</a>&nbsp;</th>
1144   <th %s>&nbsp;Name&nbsp;</th>
1145   <th %s>&nbsp;URL&nbsp;</th>
1146  </tr>
1147  <tr><td colspan=7></td></tr>
1148 EOF
1149                 $conf{th_left}, $req->{self}, $conf{th_artist}, $conf{th_album};
1150
1151         my $sth = $req->{dbh}->prepare("SELECT id,filename,title FROM song WHERE " .
1152                 "filename REGEXP '^[a-z]+:' ORDER BY title");
1153         $sth->execute
1154                 or die "can't do sql command: " . $req->{dbh}->errstr;
1155
1156         my ($editurl, $editname);
1157         while($_ = $sth->fetchrow_hashref) {
1158                 my $ref = sprintf(qq|<a id=a href="%s?cmd=add&ids=%d" target=tframe>|,
1159                         $req->{self}, $_->{id});
1160                 printf <<EOF,
1161  <tr>
1162   <td %s>&nbsp;%s&nbsp;</td>
1163   <td %s>&nbsp;%s</a>&nbsp;</td>
1164   <td %s>&nbsp;%s</a>&nbsp;</td>
1165   <td %s>&nbsp;<a id=a href="%s?cmd=shoutcast&editid=%d" target=bframe>%s</a>&nbsp;</td>
1166  </tr>
1167 EOF
1168                 $conf{td_left}, "$ref$conf{addtext}</a>",
1169                 $conf{td_artist}, $_->{title},
1170                 $conf{td_album}, $_->{filename},
1171                 $conf{td_track}, $req->{self}, $_->{id}, '*';
1172
1173                 if($_->{id} == $req->{args}->{editid}) {
1174                         $editurl = $_->{filename};
1175                         $editname = $_->{title};
1176                 }
1177         }
1178
1179         printf <<EOF,
1180 </table>
1181 <br>
1182 <hr>
1183 %s server:
1184 <form action="%s" method=get>
1185  <input type=hidden name=cmd value=shoutcast>
1186  <input type=hidden name=editid value=%d>
1187  <table>
1188  <tr><td>URL:</td><td><input type=text size=60 name=url value="%s"></td></tr>
1189  <tr><td>Description:</td><td><input type=text size=60 name=name value="%s">
1190          <input type=submit name=action_clear_name value="Clear"></td></tr>
1191  <td><td></td></tr>
1192  <tr><td colspan=2><input type=submit value="%s">%s</td></tr>
1193  </table>
1194 </form>
1195 <br>
1196 EOF
1197         $req->{args}->{editid}? "Edit" : "Add",
1198         $req->{self}, $req->{args}->{editid},
1199         enchtml($editurl || ""),
1200         enchtml($editname || ""),
1201         $req->{args}->{editid}? "Update" : "Add",
1202         $req->{args}->{editid}?
1203                 sprintf(qq|&nbsp;<input type=submit name=delete_%d value="Delete">|,
1204                 $req->{args}->{editid}) : "";
1205 }
1206
1207 sub print_lists($) {
1208         my ($req) = @_;
1209
1210         print <<EOF;
1211 <script language="Javascript">
1212 <!--
1213 function verifydelete() {
1214    return confirm("Are you sure you want to delete this playlist and its contents?");
1215 }
1216 // -->
1217 </script>
1218 <center id=hdr>Playlists</center>
1219 <table border=0 cellspacing=0>
1220  <tr>
1221   <th $conf{th_left}>&nbsp</th>
1222   <th $conf{th_left}>&nbsp;Name&nbsp;</th>
1223   <th $conf{th_left}>&nbsp;# Songs&nbsp;</th>
1224   <th $conf{th_left} id=t>&nbsp;Time&nbsp;</th>
1225   <th $conf{th_left} id=t>&nbsp;Size (Mb)</th>
1226  </tr>
1227  <tr><td colspan=3></td></tr>
1228 EOF
1229         my $sth = $req->{dbh}->prepare(<<EOF);
1230 SELECT list.id AS list_id,list.name,
1231        COUNT(song.present) AS count,
1232        SUM(song.length) AS length,
1233        SUM(FLOOR((song.filesize + 1023) / 1024)) AS size
1234 FROM list
1235 LEFT JOIN list_contents ON list.id=list_id
1236 LEFT JOIN song ON list_contents.song_id=song.id
1237 WHERE list.id AND (song.present OR song.present IS NULL)
1238 GROUP BY list.id
1239 ORDER BY list.name
1240 EOF
1241         $sth->execute()
1242                 or die "can't do sql command: " . $req->{dbh}->errstr;
1243         while(my $d = $sth->fetchrow_hashref) {
1244                 printf <<EOF,
1245  <tr>
1246   <td %s>&nbsp;<a href="%s?cmd=dellist&id=%d" %s>del</a>&nbsp;</td>
1247   <td>&nbsp;<a id=a href="%s?cmd=lists&list=%d&list_name=%s">%s</a>&nbsp;</td>
1248   <td %s>&nbsp;<a id=a href="%s?cmd=alllist&qlist=%d&cap=%s&no_artist_rows=1">%d</a>&nbsp;</td>
1249   <td id=t>&nbsp;%d:%02d:%02d&nbsp;</td>
1250   <td %s id=t>&nbsp;%.1f&nbsp;</td>
1251   <td>&nbsp;%s&nbsp;</td>
1252  </tr>
1253 EOF
1254                 $conf{td_left}, $req->{self}, $d->{list_id}, ($d->{count}? 'onclick="return verifydelete();"':""),
1255                 $req->{self}, $d->{list_id}, encurl($d->{name}), $d->{name},
1256                 $conf{td_left}, req->{self}, $d->{list_id}, encurl("Playlist \"$d->{name}\""), $d->{count},
1257                 $d->{length} / 3600, ($d->{length} / 60) % 60, $d->{length} % 60,
1258                 $conf{td_left}, $d->{size} / 1024,
1259                 $d->{list_id} == $req->{list}? "(selected)":"";
1260         }
1261         my ($count, $len, $size) = $req->{dbh}->selectrow_array(
1262                 "SELECT COUNT(*),SUM(length),SUM(FLOOR((song.filesize + 1023) / 1024)) FROM song WHERE present");
1263         printf <<EOF,
1264  <tr>
1265   <td %s>&nbsp;</td>
1266   <td>&nbsp;<a id=a href="%s?cmd=lists&list=&list_name=">(all songs)</a>&nbsp;</td>
1267   <td %s>&nbsp;%d&nbsp;</td>
1268   <td id=t>&nbsp;%d:%02d:%02d&nbsp;</td>
1269   <td %s id=t>&nbsp;%.1f&nbsp;</td>
1270   <td>&nbsp;%s&nbsp;</td>
1271  </tr>
1272 EOF
1273                 $conf{td_left},
1274                 $req->{self},
1275                 $conf{td_left}, $count,
1276                 $len / 3600, ($len / 60) % 60, $len % 60,
1277                 $conf{td_left}, $size / 1024,
1278                 $req->{list}? "":"(selected)";
1279         print <<EOF;
1280 </table>
1281 <p>
1282 <form id=search action="$req->{self}" method=get target=bframe>
1283 <input type=text size=20 name=listname>
1284 <input type=hidden name=cmd value=addlist>
1285 <input type=submit value="Create new playlist">
1286 </form>
1287 EOF
1288 }
1289
1290 sub printhtmlhdr(;$) {
1291         my ($req) = @_;
1292
1293         printhttphdr($req->{cookies});
1294         print <<EOF;
1295 <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">
1296 EOF
1297 }
1298
1299 sub printhdr($;$) {
1300         print <<EOF;
1301 <html>
1302 <head>
1303 <style type="text/css">
1304 <!--
1305 $_[0]
1306 -->
1307 </style>
1308 </head>
1309 <body $conf{body} $_[1]>
1310 EOF
1311 }
1312
1313 sub printftr() {
1314         print <<EOF;
1315 </body>
1316 </html>
1317 EOF
1318 }
1319
1320 sub printredir($$$) {
1321         my ($req, $cmd, $argsref) = @_;
1322         $argsref->{cmd} = $cmd;
1323         print $req->{cgiquery}->redirect(construct_url($req->{self}, $argsref));
1324 }
1325
1326 sub printredir_pq($) {
1327         my ($req) = @_;
1328         print $req->{cgiquery}->redirect($req->{self} . "?" . $req->{cgiquery}->param("pq"));
1329 }
1330
1331 sub add_search_args($$$$@) {
1332         my ($where, $list, $sort, $val, @fields) = @_;
1333         my $v;
1334
1335         # split on space and latin1 'no break space'
1336         foreach $v (split /[\s\xa0]+/, $val) {
1337                 my $op = "LIKE";
1338                 my $q;
1339                 if($v =~ s/^!//) { $q = "NOT "; }
1340                 if($v =~ /^\^/) { $op = "REGEXP"; }
1341                 else { $v = "%$v%"; };
1342                 $q .= "(" . join(" OR ", map { "$_ $op ?" } @fields) . ")";
1343                 push @$where, $q;
1344                 foreach(@fields) { push @$list, $v; }
1345         }
1346         $$sort = $fields[0] unless $$sort;
1347 }
1348
1349 sub delete_file($$) {
1350         my ($req, $id) = @_;
1351
1352         require_write_access;
1353
1354         printhtmlhdr($req);
1355         printhdr($conf{allstyle});
1356         $id =~ /(\d*)/;
1357         $id = $1;
1358         my ($file) = $req->{dbh}->selectrow_array("SELECT filename FROM song WHERE id=$id")
1359                 or die "id $id not found in database\n";
1360         if(unlink $file) {
1361                 print "$file deleted from disk.\n";
1362                 $req->{dbh}->do("UPDATE song SET present=0 WHERE id=$id");
1363         } else {
1364                 print "$file: <b>$!</b>\n";
1365         }
1366         printftr;
1367 }
1368
1369 sub get_user($) {
1370         my ($host) = @_;
1371         my $user = '';
1372
1373         if($host =~ /^\d+\.\d+\.\d+\.\d+$/) {
1374                 $host = gethostbyaddr(inet_aton($host), AF_INET) || $host;
1375         }
1376         if($host) {
1377                 $host =~ /^([-a-z0-9]*)/;
1378                 $user = $conf{lc "user_from_$host"} || $conf{lc "user_from_$1"} || $host;
1379         }
1380         return $user;
1381 }
1382
1383 sub handle_request($) {
1384         my ($req) = @_;
1385
1386         my %args;
1387         foreach($req->{cgiquery}->param) {
1388                 $args{$_} = $req->{cgiquery}->param($_);
1389 #               warn "\$args{$_} = $args{$_}\n";
1390         }
1391         $req->{args} = \%args;
1392 #       if($args{sid}) {
1393 #               $req->{sid} = $args{$sid};
1394 #       } elsif($req->{cookie} =~ /SID=(\w+)/i) {
1395 #               $req->{sid} = $1;
1396 #       } else {
1397 #               $req->{sid} = substr(md5_hex(time . ".$$." . rand), 0, 10);
1398 #       }
1399         if(exists $args{list}) {
1400                 $req->{cookies}->{list} = $args{list};
1401                 $req->{cookies}->{list_name} = $args{list_name};
1402         }
1403         $req->{list} = $req->{cookies}->{list};
1404         $req->{list_name} = $req->{cookies}->{list_name};
1405         $SIG{__DIE__} = sub {
1406                 printhtmlhdr;
1407                 print "<p><p>$_[0]\n";
1408                 exit 0;
1409         };
1410
1411         my $cmd = $args{cmd};
1412         my $rt = $conf{refreshtime};
1413
1414         if($cmd eq 'empty') {
1415                 printhtmlhdr($req);
1416                 print "$conf{bframe_start}\n";
1417                 return;
1418         }
1419
1420         if($cmd eq 'add') {
1421                 my @ids = ids_decode($args{ids});
1422                 if($args{skipfirstifplaying}) {
1423                         my $current = get_nowplaying();
1424                         if($current->{id} == $ids[0]) {
1425                                 my ($num) = $req->{dbh}->selectrow_array("SELECT count(*) FROM queue" .
1426                                         " LEFT JOIN song ON song.id = queue.song_id WHERE present");
1427                                 if($num == 0) {
1428                                         shift @ids;
1429                                 }
1430                         }
1431                 }
1432                 add_song($req->{dbh}, "queue", get_user($req->{host}), @ids);
1433                 printredir($req, 'playlist', undef);
1434                 return;
1435         }
1436         elsif($cmd eq 'del') {
1437                 del_song($req->{dbh}, "queue", ids_decode($args{ids}));
1438                 printredir($req, 'playlist', undef);
1439                 return;
1440         }
1441         elsif($cmd eq 'up') {
1442                 foreach(reverse split /,/, $args{id}) { move_song_to_top($req->{dbh}, "queue", $_); }
1443                 printredir($req, 'playlist', undef);
1444                 return;
1445         }
1446         elsif($cmd eq 'down') {
1447                 foreach(reverse split /,/, $args{id}) { move_song_to_bottom($req->{dbh}, "queue", $_); }
1448                 printredir($req, 'playlist', undef);
1449                 return;
1450         }
1451         elsif($cmd eq 'playmode') {
1452                 $req->{dbh}->do("UPDATE settings SET value = ? WHERE name='playmode'", undef, 0 + $args{mode});
1453                 printredir($req, 'playlist', undef);
1454                 return;
1455         }
1456         elsif($cmd eq 'kill') {
1457                 kill_song(get_user($req->{host}));
1458                 printredir($req, 'playlist', undef);
1459                 return;
1460         }
1461         elsif($cmd eq 'addnext') {
1462                 add_song_next($req->{dbh}, "queue", $args{id}, get_user($req->{host}));
1463                 printredir($req, 'playlist', undef);
1464                 return;
1465         }
1466         elsif($cmd eq 'setplaylist') {
1467                 $session{playlist} = $args{list};
1468                 printredir($req, 'playlist', undef);
1469                 return;
1470         }
1471         elsif($cmd eq 'seteditlist') {
1472                 $session{editlist} = $args{list};
1473                 printredir($req, 'playlist', undef);
1474                 return;
1475         }
1476         elsif($cmd eq 'addlist') {
1477                 require_write_access;
1478                 $args{listname} or die "No list name specified.\n";
1479                 $req->{dbh}->do("REPLACE INTO list SET name=?", undef, $args{listname})
1480                         or die;
1481                 printredir($req, 'lists', \%args);
1482                 return;
1483         }
1484         elsif($cmd eq 'addtolist') {
1485                 require_write_access;
1486                 $req->{dbh}->do("REPLACE INTO list_contents SET list_id=?, song_id=?", undef,
1487                         $args{list_id}, $args{ids})
1488                         or die;
1489                 printredir_pq($req);
1490                 return;
1491         }
1492         elsif($cmd eq 'delfromlist') {
1493                 require_write_access;
1494                 $req->{dbh}->do("DELETE FROM list_contents WHERE list_id=? AND song_id=?", undef,
1495                         $args{list_id}, $args{ids})
1496                         or die;
1497                 printredir_pq($req);
1498                 return;
1499         }
1500         elsif($cmd eq 'dellist') {
1501                 require_write_access;
1502                 $req->{dbh}->do("DELETE FROM list WHERE id=?", undef, $args{id})
1503                         or die;
1504                 $req->{dbh}->do("DELETE FROM list_contents WHERE list_id=?", undef, $args{id})
1505                         or die;
1506                 printredir($req, 'lists', \%args);
1507                 return;
1508         }
1509         elsif($cmd eq 'shuffle') {
1510                 shuffle_table($req->{dbh}, "queue");
1511                 printredir($req, 'playlist', \%args);
1512                 return;
1513         }
1514         elsif($cmd eq 'changefile') {
1515                 my $newid = 0;
1516
1517                 require_write_access;
1518
1519                 if($args{action_delete}) {
1520                         delete_file($req, $args{id});
1521                         return;
1522                 }
1523                 if($args{action_clearlp}) {
1524                         $req->{dbh}->do("UPDATE song SET last_played=from_unixtime(0) WHERE id=?",
1525                                 undef, $args{id})
1526                                 or die "can't do sql command: " . $req->{dbh}->errstr;
1527                 }
1528                 if($args{action_clearlpall}) {
1529                         foreach(ids_decode($args{ids})) {
1530                                 $req->{dbh}->do("UPDATE song SET last_played=from_unixtime(0) WHERE id=?",
1531                                         undef, $_)
1532                                         or die "can't do sql command: " . $req->{dbh}->errstr;
1533                         }
1534                 }
1535                 if($args{action_setlpall}) {
1536                         foreach(ids_decode($args{ids})) {
1537                                 $req->{dbh}->do("UPDATE song SET last_played=NULL WHERE id=?", undef, $_)
1538                                         or die "can't do sql command: " . $req->{dbh}->errstr;
1539                         }
1540                 }
1541                 if($args{action_setrpall}) {
1542                         foreach(ids_decode($args{ids})) {
1543                                 $req->{dbh}->do("UPDATE song SET random_pref=? WHERE id=?",
1544                                         undef, $args{random_pref}, $_)
1545                                         or die "can't do sql command: " . $req->{dbh}->errstr;
1546                         }
1547                 }
1548                 elsif($args{action_clear_artist})   { $args{artist} = '' }
1549                 elsif($args{action_clear_title}) { $args{title} = '' }
1550                 elsif($args{action_clear_album}) { $args{album} = '' }
1551                 elsif($args{action_fix_artist}) { $args{artist} = cleanup_name($args{artist}); }
1552                 elsif($args{action_fix_title}) { $args{title} = cleanup_name($args{title}); }
1553                 elsif($args{action_fix_album}) { $args{album} = cleanup_name($args{album}); }
1554                 elsif($args{action_swap}) {
1555                         ($args{title}, $args{artist}) = ($args{artist}, $args{title});
1556                 }
1557                 elsif($args{action_swapa}) {
1558                         $args{artist} =~ s/(.*)\s*,\s*(.*)/$2 $1/
1559                                 or $args{artist} =~ s/(.*?)\s+(.*)/$2 $1/
1560                 } else {
1561                         foreach(keys %args) {
1562                                 if(/^go_(\d+)$/) {
1563                                         $newid = $1;
1564                                         last;
1565                                 }
1566                         }
1567                 }
1568                 my $arid = get_id($req->{dbh}, "artist", $args{artist}) or die;
1569                 my $alid = get_id($req->{dbh}, "album", $args{album}) or die;
1570
1571                 $req->{dbh}->do("UPDATE song SET artist_id=?, title=?, album_id=?, track=?, random_pref=? WHERE id=?",
1572                         undef, $arid, $args{title}, $alid, $args{track}, $args{random_pref}, $args{id})
1573                         or die "can't do sql command: " . $req->{dbh}->errstr;
1574
1575                 my ($all_field, $all_field_arg);
1576                 if($args{action_all_artist}) {
1577                         $all_field = 'artist';
1578                         $all_field_arg = $arid;
1579                 } elsif($args{action_all_album}) {
1580                         $all_field = 'album';
1581                         $all_field_arg = $alid;
1582                 }
1583                 if($all_field) {
1584                         my @ids = ids_decode($args{ids});
1585
1586                         while(@ids) {
1587                                 my @ids2 = splice(@ids, 0, 50);
1588                                 $req->{dbh}->do("UPDATE song SET ${all_field}_id=? WHERE " .
1589                                         join(" OR ", map { "id=$_" }  @ids2),
1590                                         undef, $all_field_arg, @ids2)
1591                                         or die "can't do sql command: " . $req->{dbh}->errstr;
1592                         }
1593                 }
1594
1595                 if($newid) { $args{id} = $newid; }
1596                 printredir($req, 'edit', \%args);
1597                 return;
1598         }
1599
1600         if($cmd eq 'search') {
1601                 if(!$args{stype}) {
1602                         printhtmlhdr($req);
1603                         printhdr($conf{allstyle});
1604                         print "Error: No search type specified.\n";
1605                         printftr;
1606                         return;
1607                 }
1608                 $args{$args{stype}} = $args{sval};
1609                 if($args{stype} eq 'artist') {
1610                         $cmd = 'artistlist';
1611                 } else {
1612                         $cmd = 'alllist';
1613                 }
1614         }
1615
1616
1617         if($cmd eq '') {
1618                 printhtmlhdr($req);
1619                 print_frame($req);
1620         }
1621         elsif($cmd eq 'playlist') {
1622                 printhtmlhdr($req);
1623                 print <<EOF;
1624 <META HTTP-EQUIV="Refresh" CONTENT="$rt;URL=$req->{self}?cmd=playlist&s=$args{s}&nofocus=1">
1625 EOF
1626                 printhdr($conf{plstyle}, "onLoad=do_onload()");
1627                 print_az_table($req, \%session);
1628                 print_playlist_table($req);
1629         #       printf "[[%s]]\n", $bla;
1630                 printftr;
1631         }
1632         elsif($cmd eq 'artistlist') {
1633                 printhtmlhdr($req);
1634                 printhdr($conf{artiststyle});
1635
1636                 my ($cap, $s, @qw, @qwa);
1637
1638                 if($args{artist} =~ /\S/) {
1639                         add_search_args(\@qw, \@qwa, \$s, $args{artist}, 'artist.name');
1640                         $cap = "Search Artist: $args{artist}";
1641                 }
1642                 if($args{album} =~ /\S/) {
1643                         add_search_args(\@qw, \@qwa, \$s, $args{album}, 'album.name');
1644                         $cap = "Search Album: $args{album}";
1645                 }
1646                 if(scalar @qwa > 0) {
1647                         $s =~ s/^r_(.*)/\1 DESC/;
1648                         my $qw = join(" AND ", @qw);
1649                         print_artistlist_table($req, \%session, $cap, <<EOF, @qwa);
1650 SELECT DISTINCT artist.name as artist, album.name as album, count(*) as c,
1651    song.artist_id as arid, song.album_id as alid, song.random_pref
1652 FROM song
1653 LEFT JOIN artist ON artist.id=song.artist_id
1654 LEFT JOIN album ON album.id=song.album_id
1655 WHERE present AND filename LIKE '/%' AND
1656 $qw
1657 GROUP BY artist_id, album_id
1658 ORDER BY UCASE(artist.name),UCASE(album.name)
1659 EOF
1660                 } else {
1661                         print "Error: No search terms specified.\n";
1662                 }
1663                 printftr;
1664         }
1665         elsif($cmd eq 'alllist') {
1666                 printhtmlhdr($req);
1667                 printhdr($conf{allstyle});
1668                 my @qs = (
1669                         "artist.name as artist",
1670                         "album.name as album",
1671                         "song.*",
1672                         "song.artist_id as arid",
1673                         "song.album_id as alid",
1674                         "filename",
1675                 );
1676                 my @qj = (
1677                         "LEFT JOIN artist ON artist.id=song.artist_id",
1678                         "LEFT JOIN album ON album.id=song.album_id",
1679                 );
1680                 my @qja;
1681                 my @qw = ("present");
1682                 my @qwa;
1683                 my $cap;
1684                 my $limit = $conf{alllist_limit};
1685                 my $s = $args{sort};
1686                 my $filename_restriction = "/%";
1687                 $s =~ s/\W//g;
1688                 if($args{qlist}) {
1689                         push @qj, "LEFT JOIN list_contents AS qlist ON qlist.song_id=song.id AND qlist.list_id=?";
1690                         push @qja, $args{qlist};
1691                 }
1692                 if($req->{list}) {
1693                         push @qs, "list_contents.list_id > 0 as in_list";
1694                         push @qj, "LEFT JOIN list_contents ON list_contents.song_id=song.id AND list_contents.list_id=?";
1695                         push @qja, $req->{list};
1696                 }
1697                 if($args{any} =~ /\S/) {
1698                         add_search_args(\@qw, \@qwa, \$s, $args{any},
1699                                 'artist.name', 'title', 'album.name');
1700                         $cap = "Search any: $args{any}";
1701                 }
1702                 if($args{artist} =~ /\S/) {
1703                         add_search_args(\@qw, \@qwa, \$s, $args{artist}, 'artist.name');
1704                         $cap = "Search Artist: $args{artist}";
1705                 }
1706                 if($args{album} =~ /\S/) {
1707                         add_search_args(\@qw, \@qwa, \$s, $args{album}, 'album.name');
1708                         $cap = "Search Album: $args{album}";
1709                 }
1710                 if($args{title} =~ /\S/) {
1711                         add_search_args(\@qw, \@qwa, \$s, $args{title}, 'title');
1712                         $cap = "Search Title: $args{title}";
1713                 }
1714                 if($args{filename} =~ /\S/) {
1715                         add_search_args(\@qw, \@qwa, \$s, lc($args{filename}), 'lcase(filename)');
1716                         $cap = "Search Filename: $args{filename}";
1717                 }
1718                 if($args{lyrics} =~ /\S/) {
1719                         $s = "artist.name" unless $s;
1720                         push @qj, "LEFT JOIN lyrics ON lyrics.id=song.id";
1721                         add_search_args(\@qw, \@qwa, \$s, lc($args{lyrics}), 'lcase(lyrics)');
1722                         $cap = "Search Title: $args{title}";
1723                 }
1724
1725                 if($args{artist_id}) {
1726                         push @qw, "song.artist_id=?";
1727                         push @qwa, $args{artist_id};
1728                         $s = "artist.name" unless $s;
1729                         $cap = sprintf($args{cap}, $args{artist_id});
1730                 }
1731                 if($args{album_id}) {
1732                         push @qw, "song.album_id=?";
1733                         push @qwa, $args{album_id};
1734                         $s = "album.name" unless $s;
1735                         $cap = sprintf($args{cap}, $args{album_id});
1736                 }
1737                 if($args{encoding}) {
1738                         $s = "artist.name" unless $s;
1739                         add_search_args(\@qw, \@qwa, \$s, $args{encoding}, 'encoding');
1740                         $cap = "Search Encoding: $args{encoding}";
1741                 }
1742                 if($args{rand}) {
1743                         $limit = 0 + $args{rand};
1744                         $s = "rand()";
1745                 }
1746                 if($args{cdda} =~ /^(\w+)/) {
1747                         $s = "track";
1748                         $filename_restriction = "cdda:%";
1749                         $cap = "CD-DA ($1)";
1750                 }
1751                 push @qw, "filename LIKE ?";
1752                 push @qwa, $filename_restriction;
1753
1754                 if($args{qlist}) {
1755                         push @qw, "qlist.list_id";
1756                         $cap = $args{cap};
1757                         $s = "qlist.song_order" if !$s;
1758                 }
1759                 if($s) {
1760                         $s =~ s/^r_(.*)/\1 DESC/;
1761                         if($s eq "encoding") { $s = "substring_index(encoding, '(', 1)"; }
1762                         my $q = sprintf "SELECT %s FROM song %s WHERE %s ORDER BY %s",
1763                                 join(",", @qs), join(" ", @qj), join(" AND ", @qw),
1764                                 "$s,album.name,track,artist.name,title,time_added,encoding";
1765                         print_alllist_table($req, \%session, $cap, $q, $limit, (@qja, @qwa));
1766                 } else {
1767                         print "Error: No search terms specified.\n";
1768                 }
1769         #       printf "[[%s]]\n", $bla;
1770                 printftr;
1771         }
1772         elsif($cmd eq 'albumlist') {
1773                 printhtmlhdr($req);
1774                 printhdr($conf{allstyle});
1775                 print <<EOF;
1776 <center id=hdr>$args{cap}</center>
1777 EOF
1778                 print_seealso_row($req, $args{artist_id});
1779                 print_albums_row($req, $req->{self}, $args{artist_id}, "Albums: ", 1);
1780                 printftr;
1781         }
1782         elsif($cmd eq 'sql') {
1783                 require_write_access;
1784
1785                 if($args{limit} > 500) { $args{limit} = 500; }
1786
1787                 printhtmlhdr($req);
1788                 printhdr($conf{allstyle});
1789
1790                 printf <<EOF, enchtml($args{sql}), defined($args{limit})? $args{limit} : 500;
1791 SQL-query:<br>
1792 <form action="$req->{self}" method=get>
1793   <input type=hidden name=cap value="SQL-query">
1794   <input type=hidden name=cmd value=sql>
1795 <code>
1796 SELECT ... FROM ... WHERE ... AND <input type=text size=80 name=sql value="%s">
1797 Limit: <input type=text size=5 name=limit value=%d> (0=count only)
1798 <input type=submit value=Submit>
1799 </code>
1800 </form>
1801 EOF
1802
1803                 if($args{sql}) {
1804                         if($args{limit} == 0) {
1805                                 my ($count) = $req->{dbh}->selectrow_array("SELECT COUNT(*) ".
1806                                         "FROM song " .
1807                                         "LEFT JOIN artist ON artist.id=song.artist_id " .
1808                                         "LEFT JOIN album ON album.id=song.album_id " .
1809                                         "LEFT JOIN lyrics ON lyrics.id=song.id " .
1810                                         "WHERE present AND " .
1811                                         $args{sql});
1812                                 print "Count: $count\n";
1813                         } else {
1814                                 print_alllist_table($req, \%session, "User SQL-query",
1815                                         "SELECT artist.name as artist,album.name as album,song.*," .
1816                                         "song.artist_id as arid, song.album_id as alid, filename " .
1817                                         "FROM song " .
1818                                         "LEFT JOIN artist ON artist.id=song.artist_id " .
1819                                         "LEFT JOIN album ON album.id=song.album_id " .
1820                                         "LEFT JOIN lyrics ON lyrics.id=song.id " .
1821                                         "WHERE present AND " .
1822                                         $args{sql} . " LIMIT $args{limit}");
1823                         }
1824                 }
1825                 printftr;
1826         }
1827         elsif($cmd eq 'recent') {
1828                 printhtmlhdr($req);
1829                 printhdr($conf{allstyle});
1830                 my $maxage = $args{days} * 86400;
1831                 my $s = $args{sort} || "r_time_added";
1832                 $s =~ s/\W//g;
1833                 $s =~ s/^r_(.*)/\1 DESC/;
1834                 $args{limit} <= 500 or $args{limit} = 500;
1835                 print_alllist_table($req, \%session,
1836                         "Most recent $args{limit} songs" . ($args{np}? " (never played yet)":""),
1837                         "SELECT artist.name as artist,album.name as album,song.*," .
1838                         "song.artist_id as arid, song.album_id as alid, filename" .
1839                         " FROM song,artist,album WHERE present AND filename LIKE '/%'" .
1840                         " AND song.artist_id=artist.id AND song.album_id=album.id" .
1841                         " AND unix_timestamp(now()) - unix_timestamp(time_added) < $maxage" .
1842                         ($args{np}? " AND unix_timestamp(last_played) = 0":"") .
1843                         " ORDER BY $s,album.name,track,artist.name,title", $args{limit});
1844                 printftr;
1845         }
1846         elsif($cmd eq 'maint') {
1847                 printhtmlhdr($req);
1848                 printhdr($conf{allstyle});
1849                 print <<EOF;
1850 </script>
1851 <center id=hdr>Update Database</center>
1852 <form action="$req->{self}" method=get>
1853  <input type=hidden name=cmd value=update>
1854  <input type=submit value="Update Database"><br><br>
1855  Updating the database will take a while; don't press the 'stop' button on your browser if you want this to succeed.
1856 </form>
1857 EOF
1858                 printftr;
1859         }
1860         elsif($cmd eq 'update') {
1861                 require_write_access;
1862                 print $req->{cgiquery}->header(-type=>'text/plain');
1863                 print `$progdir/soepkiptng_update 2>&1`;
1864         }
1865         elsif($cmd eq 'edit') {
1866                 printhtmlhdr($req);
1867                 printhdr($conf{editstyle});
1868                 print_edit_page($req);
1869                 printftr;
1870         }
1871         elsif($cmd eq 'lyrics') {
1872                 printhtmlhdr($req);
1873                 printhdr($conf{editstyle});
1874                 print_lyrics_page($req);
1875                 printftr;
1876         }
1877         elsif($cmd eq 'googlelyrics') {
1878                 print_lyrics_google_redir($req);
1879         }
1880         elsif($cmd eq 'shoutcast') {
1881                 printhtmlhdr($req);
1882                 printhdr($conf{allstyle});
1883                 print_shoutcast_page($req);
1884                 printftr;
1885         }
1886         elsif($cmd eq 'download') {
1887                 $args{id} =~ /(\d+)/;
1888                 my $id = $1;
1889                 my ($file) = $req->{dbh}->selectrow_array("SELECT filename FROM song WHERE id=$id")
1890                         or die "id $id not found in database\n";
1891
1892                 open F, $file or die "$file: $!\n";
1893                 print $req->{cgiquery}->header(-type=>'application/octet-stream', -Content_length=>(-s F));
1894                 while(read F, $_, 4096) { print; }
1895                 close F;
1896         }
1897         elsif($cmd eq 'downloadset') {
1898                 my @ids = ids_decode($args{ids});
1899                 my @tarargs;
1900                 local *F;
1901
1902                 foreach(@ids) {
1903                         my ($file) = $req->{dbh}->selectrow_array("SELECT filename FROM song WHERE id=$_")
1904                                 or die "id $id not found in database\n";
1905                         $file =~ s|(.*)/||;
1906                         push @tarargs, "-C", $1, $file;
1907                 }
1908                 print $req->{cgiquery}->header(-type=>'application/octet-stream');
1909                 if(open(F, "-|") == 0) {
1910                         setpriority 0, 0, 10;
1911                         exec "tar", "cf", "-", "--numeric-owner", @tarargs;
1912                         die "tar";
1913                 }
1914                 while(read F, $_, 4096) { print; }
1915                 close F;
1916         }
1917         elsif($cmd eq 'lists') {
1918                 printhtmlhdr($req);
1919                 printhdr($conf{allstyle});
1920                 print_lists($req);
1921                 $req->{cookies}->{list} = $args{list};
1922                 printftr;
1923         }
1924         elsif($cmd eq 'cdda') {
1925                 local *F;
1926                 if(!$conf{cdda_prog}) {
1927                         die "CD-DA not configured\n";
1928                 }
1929                 $req->{dbh}->do("DELETE FROM song WHERE filename LIKE 'cdda:%'");
1930                 open F, "$conf{cdda_prog}|";
1931                 chop(my $cddbinfo = <F>);
1932                 chop($_ = <F>);
1933                 my $arid = get_id($req->{dbh}, "artist", $_) or die;
1934                 chop($_ = <F>);
1935                 my $alid = get_id($req->{dbh}, "album", $_) or die;
1936                 my $nr = 1;
1937                 while(<F>) {
1938                         chop;
1939                         s/^(\d+) //;
1940                         my $len = $1;
1941                         $req->{dbh}->do("REPLACE INTO song SET title=?, filename=?, album_id=?, " .
1942                                 "artist_id=?, present=1, encoding='CD-DA', track=?, " .
1943                                 "length=?, time_added=NULL", undef,
1944                                 $_, "cdda:$cddbinfo:$nr", $alid, $arid, $nr, $len) or die;
1945                         $nr++;
1946                 }
1947                 close F;
1948                 $args{cdda} = $cddbinfo;
1949                 printredir($req, 'alllist', \%args);
1950         }
1951         else {
1952                 printhtmlhdr($req);
1953                 print "oei: $cmd\n";
1954         }
1955 }
1956
1957 1;