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 pause(;$) {
 246         my $cmd = $_[0] || "pausetoggle";
 247
 248         my $sock = IO::Socket::INET->new('localhost:2222') or return undef;
 249         $sock->autoflush(1);
 250         $response = <$sock>;    #greeting
 251         $sock->print("$cmd\n");
 252         $response = <$sock>;
 253         $sock->close;
 254
 255         return $response =~ /^\+/;
 256 }
 257
 258
 259 sub get_player_pid() {
 260         local *F;
 261         my $pid;
 262
 263         open F, $conf{statusfile}
 264                 or die "$conf{statusfile}: $!\n";
 265         <F>; <F>; <F>;
 266         $pid = 0 + <F>;
 267         close F;
 268         return $pid;
 269 }
 270
 271 sub get_id($$$) {
 272         my ($db, $table, $value) = @_;
 273
 274         my $sth = $db->prepare("SELECT id,name FROM $table WHERE binary name=?");
 275         if($sth->execute($value || "") >= 1) {
 276                 my ($id, $v) = $sth->fetchrow_array;
 277                 return $id;
 278         } else {
 279                 $db->do("REPLACE INTO $table SET name=?", undef, $value)
 280                         or die;
 281                 return $db->{'mysql_insertid'};
 282         }
 283 }
 284
 285 sub get_playlist_contents($$) {
 286         my ($dbh, $list) = @_;
 287         my %songids;
 288         my (%artistids, %albumsids, %listids);
 289         my (%artistids_done, %albumsids_done, %listids_done);
 290
 291         my $sth_list = $dbh->prepare("SELECT type,entity_id" .
 292                 " FROM list_contents WHERE list_id=?");
 293         my $sth_artist = $dbh->prepare("SELECT id FROM song WHERE artist_id=?");
 294         my $sth_album = $dbh->prepare("SELECT id FROM song WHERE album_id=?");
 295
 296         $listids{$list} = 1;
 297         while(%artistids || %albumsids || %listids) {
 298                 foreach(keys %listids) {
 299                         $listids_done{$_} = 1;
 300                         delete $listids{$_};
 301
 302                         $sth_list->execute($_);
 303                         while($_ = $sth_list->fetchrow_hashref) {
 304                                 if($_->{'type'} eq 'list') {
 305                                         next if $listids_done{$_->{'entity_id'}};
 306                                         $listids{$_->{'entity_id'}} = 1;
 307                                 } elsif($_->{'type'} eq 'artist') {
 308                                         next if $artistids_done{$_->{'entity_id'}};
 309                                         $artistids{$_->{'entity_id'}} = 1;
 310                                 } elsif($_->{'type'} eq 'album') {
 311                                         next if $albumids_done{$_->{'entity_id'}};
 312                                         $albumids{$_->{'entity_id'}} = 1;
 313                                 } elsif($_->{'type'} eq 'song') {
 314                                         $songids{$_->{'entity_id'}} = 1;
 315                                 }
 316                         }
 317                 }
 318                 foreach(keys %artistids) {
 319                         $artistids_done{$_} = 1;
 320                         delete $artistids{$_};
 321
 322                         $sth_artist->execute($_);
 323                         while($_ = $sth_artist->fetchrow_hashref) {
 324                                 $songids{$_->{'id'}} = 1;
 325                         }
 326                 }
 327                 foreach(keys %albumids) {
 328                         $albumids_done{$_} = 1;
 329                         delete $albumids{$_};
 330
 331                         $sth_album->execute($_);
 332                         while($_ = $sth_album->fetchrow_hashref) {
 333                                 $songids{$_->{'id'}} = 1;
 334                         }
 335                 }
 336         }
 337         return keys %songids;
 338 }
 339
 340 sub get_nowplaying(;$) {
 341         my ($dbh) = @_;
 342         local *F;
 343         my $s = undef;
 344
 345         open F, $conf{statusfile} or return undef;
 346         chop (($s->{id}, $s->{filename}, $s->{pid}, $s->{cdrplaypid},
 347                $s->{killhost}, $s->{killport}, $s->{type},
 348                $s->{user}, $s->{artist}, $s->{title}, $s->{album},
 349                $s->{track}, $s->{length}, $s->{encoding}) = <F>);
 350         close F;
 351
 352         if($dbh) {
 353                 my $sth = $dbh->prepare(
 354                         "SELECT artist.name as artist,album.name as album," .
 355                         " song.artist_id as arid,song.album_id as alid, song.*" .
 356                         " FROM song,artist,album WHERE song.artist_id=artist.id" .
 357                         " AND song.album_id=album.id AND song.id=?");
 358                 $sth->execute($s->{id});
 359                 if(my $d = $sth->fetchrow_hashref) {
 360                         $s->{alid} = $d->{alid};
 361                         $s->{arid} = $d->{arid};
 362                         $s->{filename} = $d->{filename};
 363                         $s->{artist} = $d->{artist};
 364                         $s->{title} = $d->{title};
 365                         $s->{album} = $d->{album};
 366                         $s->{track} = $d->{track};
 367                         $s->{length} = $d->{length};
 368                         $s->{encoding} = $d->{encoding};
 369                 }
 370         }
 371         return $s;
 372 }
 373
 374 sub construct_url($@) {
 375         my ($baseurl, $argsref) = @_;
 376         my $sep = "?";
 377         foreach(keys %$argsref) {
 378                 $baseurl .= "$sep$_=" . encurl($$argsref{$_});
 379                 $sep = "&";
 380         }
 381         return $baseurl;
 382 }
 383
 384 sub cleanup_name {
 385         my ($s) = @_;
 386         $s =~ s/\.mp3\s*$//i;
 387         $s =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eig;
 388         $s =~ s/([a-zA-Z])([A-Z][a-z])/$1 $2/g;
 389         $s = lc($s);
 390         $s =~ s/_/ /g;
 391         if($s !~ / /) { $s =~ s/\./ /g; }
 392         $s =~ s/^\s+|\s+$//g;
 393         $s =~ s/([^'\w\xc0-\xff]|^)(\w)/$1\U$2/g;
 394         $s =~ s/\b(o'\w)/\U$1/ig;
 395         $s =~ s/n T\b/n't/g;
 396         $s =~ s/ S\b/'s/g;
 397         $s =~ s/\bI M\b/I'm/g;
 398         $s =~ s/ ll\b/'ll/ig;
 399         $s =~ s/\b(i+)\b/\U$1/ig;
 400         $s =~ s/([eiuy]) ([rv]e)\b/$1'\L$2/ig;
 401         $s =~ s/\s*-\s*/ - /g;
 402         $s;
 403 }
 404
 405 sub add_song_next($$;$) {
 406         my ($dbh, $currentsong, $user) = @_;
 407
 408         my $ids = $dbh->selectcol_arrayref("SELECT song_id FROM queue,song ".
 409                 "WHERE queue.song_id=song.id AND song.present");
 410         my %idsq;
 411         foreach(@$ids) { $idsq{$_} = 1; }
 412
 413         my $sth = $dbh->prepare("SELECT song2.* FROM song AS song1,".
 414                 " song AS song2 WHERE song1.id=$currentsong AND".
 415                 " song1.artist_id = song2.artist_id AND".
 416                 " song1.album_id = song2.album_id AND".
 417                 " song2.track > song1.track AND".
 418                 " song2.present ORDER BY song2.track");
 419         $sth->execute;
 420         while($_ = $sth->fetchrow_hashref) {
 421                 if(!$idsq{$_->{id}}) {
 422                         add_song($dbh, $user, $_->{id})
 423                                 or warn "can't add song.\n";
 424                         return $_;
 425                 }
 426         }
 427 }
 428
 429
 430 1;