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