soepkiptng.lib

   1 ############################################################################
   2 # soepkiptng (c) copyright 2000 Eric Lammerts <eric@lammerts.org>.
   3 # $Id$
   4 ############################################################################
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License, version 2, as
   7 # published by the Free Software Foundation.
   8 #
   9 # This program is distributed in the hope that it will be useful,
  10 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 # GNU General Public License for more details.
  13 #
  14 # A copy of the GNU General Public License is available on the World Wide Web
  15 # at `http://www.gnu.org/copyleft/gpl.html'.  You can also obtain it by
  16 # writing to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  17 # Boston, MA 02111-1307, USA.
  18 ############################################################################
  19
  20 use IO::Socket;
  21 use Socket;
  22
  23 my @globalconfigfiles = ($ENV{SOEPKIPTNG_CONFIGFILE},
  24    "$ENV{HOME}/.soepkiptng.conf", "/etc/soepkiptng.conf");
  25
  26 sub read_configfile($;@) {
  27         my ($conf, @extraconfigfiles) = @_;
  28         my $cf;
  29
  30         foreach $cf ((@extraconfigfiles, @globalconfigfiles)) {
  31                 local *F;
  32                 defined($cf) && -f $cf or next;
  33                 open F, $cf or next;
  34                 while(<F>) {
  35                         /^#/ and next;
  36                         s/\s+$//;
  37                         /./ or next;
  38                         if(/^(\w+)\s*=\s*(.*?)\s*$/) {
  39                                 $f = $1;
  40                                 $conf->{$f} = $2;
  41                         } elsif(/^\s+(.*?)\s*$/) {
  42                                 # continuation line
  43                                 $conf->{$f} .= "\n$1";
  44                         } else {
  45                                 die "$cf line $.: invalid format\n";
  46                         }
  47                 }
  48                 close F;
  49                 return;
  50         }
  51         die sprintf "no configuration file found (tried %s)\n",
  52                 join(" ", @extraconfigfiles, @globalconfigfiles);
  53 }
  54
  55 %latin1toascii = (
  56         192 => 'A',             # capital A, grave accent
  57         193 => 'A',             # capital A, acute accent
  58         194 => 'A',             # capital A, circumflex accent
  59         195 => 'A',             # capital A, tilde
  60         196 => 'A',             # capital A, dieresis or umlaut mark
  61         197 => 'AA',            # capital A, ring
  62         198 => 'AE',            # capital AE diphthong (ligature)
  63         199 => 'C',             # capital C, cedilla
  64         200 => 'E',             # capital E, grave accent
  65         201 => 'E',             # capital E, acute accent
  66         202 => 'E',             # capital E, circumflex accent
  67         203 => 'E',             # capital E, dieresis or umlaut mark
  68         204 => 'I',             # capital I, grave accent
  69         205 => 'I',             # capital I, acute accent
  70         206 => 'I',             # capital I, circumflex accent
  71         207 => 'I',             # capital I, dieresis or umlaut mark
  72         209 => 'N',             # capital N, tilde
  73         210 => 'O',             # capital O, grave accent
  74         211 => 'O',             # capital O, acute accent
  75         212 => 'O',             # capital O, circumflex accent
  76         213 => 'O',             # capital O, tilde
  77         214 => 'O',             # capital O, dieresis or umlaut mark
  78         216 => 'O',             # capital O, slash
  79         217 => 'U',             # capital U, grave accent
  80         218 => 'U',             # capital U, acute accent
  81         219 => 'U',             # capital U, circumflex accent
  82         220 => 'U',             # capital U, dieresis or umlaut mark
  83         221 => 'Y',             # capital Y, acute accent
  84         223 => 'ss',            # small sharp s, German (sz ligature)
  85         224 => 'a',             # small a, grave accent
  86         225 => 'a',             # small a, acute accent
  87         226 => 'a',             # small a, circumflex accent
  88         227 => 'a',             # small a, tilde
  89         228 => 'a',             # small a, dieresis or umlaut mark
  90         229 => 'aa',            # small a, ring
  91         230 => 'ae',            # small ae diphthong (ligature)
  92         231 => 'c',             # small c, cedilla
  93         232 => 'e',             # small e, grave accent
  94         233 => 'e',             # small e, acute accent
  95         234 => 'e',             # small e, circumflex accent
  96         235 => 'e',             # small e, dieresis or umlaut mark
  97         236 => 'i',             # small i, grave accent
  98         237 => 'i',             # small i, acute accent
  99         238 => 'i',             # small i, circumflex accent
 100         239 => 'i',             # small i, dieresis or umlaut mark
 101         241 => 'n',             # small n, tilde
 102         242 => 'o',             # small o, grave accent
 103         243 => 'o',             # small o, acute accent
 104         244 => 'o',             # small o, circumflex accent
 105         245 => 'o',             # small o, tilde
 106         246 => 'o',             # small o, dieresis or umlaut mark
 107         248 => 'o',             # small o, slash
 108         249 => 'u',             # small u, grave accent
 109         250 => 'u',             # small u, acute accent
 110         251 => 'u',             # small u, circumflex accent
 111         252 => 'u',             # small u, dieresis or umlaut mark
 112         253 => 'y',             # small y, acute accent
 113         255 => 'y',             # small y, dieresis or umlaut mark
 114 );
 115
 116 sub encurl($) {
 117         my ($a) = @_;
 118
 119         $a =~ s|([^-./\w])|sprintf "%%%02x", ord($1)|ge;
 120 #       $a =~ s| |+|g;
 121         $a;
 122 }
 123
 124 sub enchtml($;$) {
 125         my ($a, $do_nbsp) = @_;
 126
 127         $a =~ s|&|&amp;|g;
 128         $a =~ s|"|&quot;|g;
 129         $a =~ s|<|&lt;|g;
 130         $a =~ s|>|&gt;|g;
 131         $a =~ s| |&nbsp;|g if $do_nbsp;
 132         $a;
 133 }
 134
 135 sub del_song($@) {
 136         my ($db, @ids) = @_;
 137         @ids or return;
 138         $db->do("DELETE FROM queue WHERE song_id=" . join(" OR song_id=", @ids));
 139 }
 140
 141 sub add_song_nolock($$$@) {
 142         my ($db, $order, $user, @ids) = @_;
 143
 144         my $firstid = shift @ids or return;
 145         my $q = "INSERT INTO queue (song_order, song_id, user) " .
 146                 "VALUES ($order, $firstid, \"$user\")";
 147         foreach(@ids) {
 148                 $order++;
 149                 $q .= ",($order,$_,\"$user\")";
 150         }
 151         $db->do($q) or return undef;
 152         return 1;
 153 }
 154
 155 sub get_queue_ids($$) {
 156         my ($db, $rest) = @_;
 157
 158         my $res = $db->selectcol_arrayref("SELECT song_id FROM queue $rest");
 159         return @$res;
 160 }
 161
 162
 163 sub add_song($$@) {
 164         my ($db, $user, @ids) = @_;
 165
 166         $db->do("LOCK TABLES queue WRITE");
 167         del_song($db, @ids);
 168         my ($order) = $db->selectrow_array("SELECT MAX(song_order) FROM queue");
 169         $order = 0 if $order < 0;
 170         my $retval = add_song_nolock($db, $order + 1, $user, @ids);
 171         $db->do("UNLOCK TABLES");
 172         return $retval;
 173 }
 174
 175 sub reorder_queue($@) {
 176         my ($db, $order, @ids) = @_;
 177
 178         foreach(@ids) {
 179                 $db->do("UPDATE queue SET song_order=$order WHERE song_id=$_");
 180                 $order++;
 181         }
 182 }
 183
 184 sub move_song_to_top($@) {
 185         my ($db, @ids) = @_;
 186
 187         $db->do("LOCK TABLES queue WRITE");
 188         reorder_queue($db, $#ids + 2, get_queue_ids($db, "ORDER BY song_order"));
 189         reorder_queue($db, 1, @ids);
 190         $db->do("UNLOCK TABLES");
 191 }
 192
 193 sub shuffle_queue($) {
 194         my ($db) = @_;
 195
 196         $db->do("LOCK TABLES queue WRITE");
 197         reorder_queue($db, 1, get_queue_ids($db, "ORDER BY rand()"));
 198         $db->do("UNLOCK TABLES");
 199 }
 200
 201 sub kill_song(;$$) {
 202         my ($user, $id) = @_;
 203         my ($plid, $host, $port);
 204         local *F;
 205
 206         open F, $conf{statusfile}
 207                 or die "$conf{statusfile}: $!\n";
 208         $plid = <F>;
 209         <F>; <F>; <F>;
 210         chop($host = <F>);
 211         $port = <F>;
 212         close F;
 213
 214         if(defined($id) && $id != $plid) { return undef; }
 215
 216         if($conf{kill_song_external}) {
 217                 system $conf{kill_song_external}, $user || '';
 218
 219                 open F, $conf{statusfile}
 220                         or die "$conf{statusfile}: $!\n";
 221                 my @lines;
 222                 chop(@lines = <F>);
 223                 close F;
 224                 return @lines;
 225         }
 226         return kill_song_internal($host, $port);
 227 }
 228
 229 sub kill_song_internal($$) {
 230         my ($host, $port) = @_;
 231         local *F;
 232
 233         $host && $port or return undef;
 234
 235         socket(F, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
 236                 or die "socket: $!\n";
 237         connect(F, sockaddr_in($port, inet_aton($host)))
 238                 or die "connect $host:$port: $!\n";
 239         my @status;
 240         @status = <F>;
 241         close F;
 242         return @status;
 243 }
 244
 245 sub player_cmd(;@) {
 246         my $res = 1;
 247
 248         my $sock = IO::Socket::INET->new('localhost:2222') or return undef;
 249         $sock->autoflush(1);
 250         $response = <$sock>;    #greeting
 251         foreach(@_) {
 252                 $sock->print("$_\n");
 253                 $res = 0 if <$sock> !~ /^\+/;
 254         }
 255         $sock->close;
 256         return $res;
 257 }
 258
 259
 260 sub get_player_pid() {
 261         local *F;
 262         my $pid;
 263
 264         open F, $conf{statusfile}
 265                 or die "$conf{statusfile}: $!\n";
 266         <F>; <F>; <F>;
 267         $pid = 0 + <F>;
 268         close F;
 269         return $pid;
 270 }
 271
 272 sub get_id($$$) {
 273         my ($db, $table, $value) = @_;
 274
 275         my $sth = $db->prepare("SELECT id,name FROM $table WHERE binary name=?");
 276         if($sth->execute($value || "") >= 1) {
 277                 my ($id, $v) = $sth->fetchrow_array;
 278                 return $id;
 279         } else {
 280                 $db->do("REPLACE INTO $table SET name=?", undef, $value)
 281                         or die;
 282                 return $db->{'mysql_insertid'};
 283         }
 284 }
 285
 286 sub get_playlist_contents($$) {
 287         my ($dbh, $list) = @_;
 288         my %songids;
 289         my (%artistids, %albumsids, %listids);
 290         my (%artistids_done, %albumsids_done, %listids_done);
 291
 292         my $sth_list = $dbh->prepare("SELECT type,entity_id" .
 293                 " FROM list_contents WHERE list_id=?");
 294         my $sth_artist = $dbh->prepare("SELECT id FROM song WHERE artist_id=?");
 295         my $sth_album = $dbh->prepare("SELECT id FROM song WHERE album_id=?");
 296
 297         $listids{$list} = 1;
 298         while(%artistids || %albumsids || %listids) {
 299                 foreach(keys %listids) {
 300                         $listids_done{$_} = 1;
 301                         delete $listids{$_};
 302
 303                         $sth_list->execute($_);
 304                         while($_ = $sth_list->fetchrow_hashref) {
 305                                 if($_->{'type'} eq 'list') {
 306                                         next if $listids_done{$_->{'entity_id'}};
 307                                         $listids{$_->{'entity_id'}} = 1;
 308                                 } elsif($_->{'type'} eq 'artist') {
 309                                         next if $artistids_done{$_->{'entity_id'}};
 310                                         $artistids{$_->{'entity_id'}} = 1;
 311                                 } elsif($_->{'type'} eq 'album') {
 312                                         next if $albumids_done{$_->{'entity_id'}};
 313                                         $albumids{$_->{'entity_id'}} = 1;
 314                                 } elsif($_->{'type'} eq 'song') {
 315                                         $songids{$_->{'entity_id'}} = 1;
 316                                 }
 317                         }
 318                 }
 319                 foreach(keys %artistids) {
 320                         $artistids_done{$_} = 1;
 321                         delete $artistids{$_};
 322
 323                         $sth_artist->execute($_);
 324                         while($_ = $sth_artist->fetchrow_hashref) {
 325                                 $songids{$_->{'id'}} = 1;
 326                         }
 327                 }
 328                 foreach(keys %albumids) {
 329                         $albumids_done{$_} = 1;
 330                         delete $albumids{$_};
 331
 332                         $sth_album->execute($_);
 333                         while($_ = $sth_album->fetchrow_hashref) {
 334                                 $songids{$_->{'id'}} = 1;
 335                         }
 336                 }
 337         }
 338         return keys %songids;
 339 }
 340
 341 sub get_nowplaying(;$) {
 342         my ($dbh) = @_;
 343         local *F;
 344         my $s = undef;
 345
 346         open F, $conf{statusfile} or return undef;
 347         chop (($s->{id}, $s->{filename}, $s->{pid}, $s->{cdrplaypid},
 348                $s->{killhost}, $s->{killport}, $s->{type},
 349                $s->{user}, $s->{artist}, $s->{title}, $s->{album},
 350                $s->{track}, $s->{length}, $s->{encoding}) = <F>);
 351         close F;
 352
 353         if($dbh) {
 354                 my $sth = $dbh->prepare(
 355                         "SELECT artist.name as artist,album.name as album," .
 356                         " song.artist_id as arid,song.album_id as alid, song.*" .
 357                         " FROM song,artist,album WHERE song.artist_id=artist.id" .
 358                         " AND song.album_id=album.id AND song.id=?");
 359                 $sth->execute($s->{id});
 360                 if(my $d = $sth->fetchrow_hashref) {
 361                         $s->{alid} = $d->{alid};
 362                         $s->{arid} = $d->{arid};
 363                         $s->{filename} = $d->{filename};
 364                         $s->{artist} = $d->{artist};
 365                         $s->{title} = $d->{title};
 366                         $s->{album} = $d->{album};
 367                         $s->{track} = $d->{track};
 368                         $s->{length} = $d->{length};
 369                         $s->{encoding} = $d->{encoding};
 370                 }
 371         }
 372         return $s;
 373 }
 374
 375 sub construct_url($@) {
 376         my ($baseurl, $argsref) = @_;
 377         my $sep = "?";
 378         foreach(keys %$argsref) {
 379                 $baseurl .= "$sep$_=" . encurl($$argsref{$_});
 380                 $sep = "&";
 381         }
 382         return $baseurl;
 383 }
 384
 385 sub cleanup_name {
 386         my ($s) = @_;
 387         $s =~ s/\.mp3\s*$//i;
 388         $s =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eig;
 389         $s =~ s/([a-zA-Z])([A-Z][a-z])/$1 $2/g;
 390         $s = lc($s);
 391         $s =~ s/_/ /g;
 392         if($s !~ / /) { $s =~ s/\./ /g; }
 393         $s =~ s/^\s+|\s+$//g;
 394         $s =~ s/([^'\w\xc0-\xff]|^)(\w)/$1\U$2/g;
 395         $s =~ s/\b(o'\w)/\U$1/ig;
 396         $s =~ s/n T\b/n't/g;
 397         $s =~ s/ S\b/'s/g;
 398         $s =~ s/\bI M\b/I'm/g;
 399         $s =~ s/ ll\b/'ll/ig;
 400         $s =~ s/\b(i+)\b/\U$1/ig;
 401         $s =~ s/([eiuy]) ([rv]e)\b/$1'\L$2/ig;
 402         $s =~ s/\s*-\s*/ - /g;
 403         $s;
 404 }
 405
 406 sub add_song_next($$;$) {
 407         my ($dbh, $currentsong, $user) = @_;
 408
 409         my $ids = $dbh->selectcol_arrayref("SELECT song_id FROM queue,song ".
 410                 "WHERE queue.song_id=song.id AND song.present");
 411         my %idsq;
 412         foreach(@$ids) { $idsq{$_} = 1; }
 413
 414         my $sth = $dbh->prepare("SELECT song2.* FROM song AS song1,".
 415                 " song AS song2 WHERE song1.id=$currentsong AND".
 416                 " song1.artist_id = song2.artist_id AND".
 417                 " song1.album_id = song2.album_id AND".
 418                 " song2.track > song1.track AND".
 419                 " song2.present ORDER BY song2.track");
 420         $sth->execute;
 421         while($_ = $sth->fetchrow_hashref) {
 422                 if(!$idsq{$_->{id}}) {
 423                         add_song($dbh, $user, $_->{id})
 424                                 or warn "can't add song.\n";
 425                         return $_;
 426                 }
 427         }
 428 }
 429
 430
 431 1;