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.
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.
13 # A copy of the GNU General Public License is available on the World Wide Web
14 # at `http://www.gnu.org/copyleft/gpl.html'. You can also obtain it by
15 # writing to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
16 # Boston, MA 02111-1307, USA.
17 ############################################################################
21 use POSIX qw(locale_h);
23 setlocale(LC_CTYPE, "en_US.ISO-8859-1");
25 my @globalconfigfiles = ($ENV{SOEPKIPTNG_CONFIGFILE},
26 "$ENV{HOME}/.soepkiptng.conf", "/etc/soepkiptng.conf");
28 our @playmodes = ("all", "requested", "recent", "never played");
30 sub read_configfile1($$);
32 sub read_configfile1($$) {
36 open F, $cf or return undef;
41 if(/^include\s+(.*\S)/) {
42 read_configfile1($conf, $1);
45 if(/^(\w[-.\w]*)\s*=\s*(.*?)\s*$/) {
48 } elsif(/^\s+(.*?)\s*$/) {
50 $conf->{$f} .= "\n$1";
52 die "$cf line $.: invalid format\n";
59 sub read_configfile($;@) {
60 my ($conf, @extraconfigfiles) = @_;
63 foreach $cf ((@extraconfigfiles, @globalconfigfiles)) {
64 defined($cf) and read_configfile1($conf, $cf) and return;
66 die sprintf "no configuration file found (tried %s)\n",
67 join(" ", @extraconfigfiles, @globalconfigfiles);
71 128 => '_', 129 => '_', 130 => '_', 131 => '_',
72 132 => '_', 133 => '_', 134 => '_', 135 => '_',
73 136 => '_', 137 => '_', 138 => '_', 139 => '_',
74 140 => '_', 141 => '_', 142 => '_', 143 => '_',
75 144 => '_', 145 => '_', 146 => '_', 147 => '_',
76 148 => '_', 149 => '_', 150 => '_', 151 => '_',
77 152 => '_', 153 => '_', 154 => '_', 155 => '_',
78 156 => '_', 157 => '_', 158 => '_', 159 => '_',
79 160 => '_', # no-break space
80 161 => '_', # ¡ inverted exclamation mark
81 162 => 'c', # ¢ cent sign
82 163 => 'L', # £ pound sign
83 164 => 'EUR', # ¤ euro sign
84 165 => 'Y', # ¥ yen sign
85 166 => 'S', # ¦ latin capital letter s with caron
86 167 => '_', # § section sign
87 168 => 's', # ¨ latin small letter s with caron
88 169 => 'C', # © copyright sign
89 170 => 'a', # ª feminine ordinal indicator
90 171 => '_', # « left-pointing double angle quotation mark
91 172 => '_', # ¬ not sign
92 173 => '_', # soft hyphen
93 174 => 'R', # ® registered sign
94 175 => '_', # ¯ macron
95 176 => 'o', # ° degree sign
96 177 => '_', # ± plus-minus sign
97 178 => '2', # ² superscript two
98 179 => '3', # ³ superscript three
99 180 => 'Z', # ´ latin capital letter z with caron
100 181 => 'u', # µ micro sign
101 182 => '_', # ¶ pilcrow sign
102 183 => '_', # · middle dot
103 184 => 'z', # ¸ latin small letter z with caron
104 185 => '1', # ¹ superscript one
105 186 => 'o', # º masculine ordinal indicator
106 187 => '_', # » right-pointing double angle quotation mark
107 188 => 'OE', # ¼ latin capital ligature oe
108 189 => 'oe', # ½ latin small ligature oe
109 190 => 'IJ', # ¾ latin capital letter y with diaeresis
110 191 => '_', # ¿ inverted question mark
111 192 => 'A', # capital A, grave accent
112 193 => 'A', # capital A, acute accent
113 194 => 'A', # capital A, circumflex accent
114 195 => 'A', # capital A, tilde
115 196 => 'A', # capital A, dieresis or umlaut mark
116 197 => 'A', # capital A, ring
117 198 => 'AE', # capital AE diphthong (ligature)
118 199 => 'C', # capital C, cedilla
119 200 => 'E', # capital E, grave accent
120 201 => 'E', # capital E, acute accent
121 202 => 'E', # capital E, circumflex accent
122 203 => 'E', # capital E, dieresis or umlaut mark
123 204 => 'I', # capital I, grave accent
124 205 => 'I', # capital I, acute accent
125 206 => 'I', # capital I, circumflex accent
126 207 => 'I', # capital I, dieresis or umlaut mark
127 208 => '_', # Ð latin capital letter eth
128 209 => 'N', # capital N, tilde
129 210 => 'O', # capital O, grave accent
130 211 => 'O', # capital O, acute accent
131 212 => 'O', # capital O, circumflex accent
132 213 => 'O', # capital O, tilde
133 214 => 'O', # capital O, dieresis or umlaut mark
134 215 => 'x', # ×, multiplication sign
135 216 => 'O', # capital O, slash
136 217 => 'U', # capital U, grave accent
137 218 => 'U', # capital U, acute accent
138 219 => 'U', # capital U, circumflex accent
139 220 => 'U', # capital U, dieresis or umlaut mark
140 221 => 'Y', # capital Y, acute accent
141 222 => '_', # Þ latin capital letter thorn
142 223 => 'ss', # small sharp s, German (sz ligature)
143 224 => 'a', # small a, grave accent
144 225 => 'a', # small a, acute accent
145 226 => 'a', # small a, circumflex accent
146 227 => 'a', # small a, tilde
147 228 => 'a', # small a, dieresis or umlaut mark
148 229 => 'a', # small a, ring
149 230 => 'ae', # small ae diphthong (ligature)
150 231 => 'c', # small c, cedilla
151 232 => 'e', # small e, grave accent
152 233 => 'e', # small e, acute accent
153 234 => 'e', # small e, circumflex accent
154 235 => 'e', # small e, dieresis or umlaut mark
155 236 => 'i', # small i, grave accent
156 237 => 'i', # small i, acute accent
157 238 => 'i', # small i, circumflex accent
158 239 => 'i', # small i, dieresis or umlaut mark
159 240 => '_', # ð latin small letter eth
160 241 => 'n', # small n, tilde
161 242 => 'o', # small o, grave accent
162 243 => 'o', # small o, acute accent
163 244 => 'o', # small o, circumflex accent
164 245 => 'o', # small o, tilde
165 246 => 'o', # small o, dieresis or umlaut mark
166 247 => '_', # ÷ division sign
167 248 => 'o', # small o, slash
168 249 => 'u', # small u, grave accent
169 250 => 'u', # small u, acute accent
170 251 => 'u', # small u, circumflex accent
171 252 => 'u', # small u, dieresis or umlaut mark
172 253 => 'y', # small y, acute accent
173 254 => '_', # þ latin small letter thorn
174 255 => 'ij', # small y, dieresis or umlaut mark
177 sub string_to_filename($;$) {
180 my $ampr = $lang eq "dut"? "en" : $lang eq "fre"? "et" : $lang eq "ger"? "und" : "and";
183 $a =~ s/[\[(](.*)/-$1/;
184 $a =~ s/[ _]?&[_ ]?/_${ampr}_/g;
185 $a =~ s/([\x80-\xff])/lc($latin9_to_ascii{ord($1)}) || $1/ge;
186 $a =~ s/[^-A-Za-z0-9]+/_/g;
195 $a =~ s|([^-./\w])|sprintf "%%%02x", ord($1)|ge;
201 my ($a, $do_nbsp) = @_;
207 $a =~ s| | |g if $do_nbsp;
212 my ($db, $tbl, @ids) = @_;
214 $db->do("DELETE FROM $tbl WHERE song_id=" . join(" OR song_id=", @ids));
217 sub add_song_nolock($$$$@) {
218 my ($db, $tbl, $order, $user, @ids) = @_;
221 my $firstid = shift @ids;
222 my $q = "INSERT INTO $tbl (song_order, song_id, user) " .
223 "VALUES ($order, $firstid, \"$user\")";
226 $q .= ",($order,$_,\"$user\")";
228 $db->do($q) or return undef;
232 sub get_table_ids($$$) {
233 my ($db, $tbl, $rest) = @_;
235 my $res = $db->selectcol_arrayref("SELECT song_id FROM $tbl $rest");
241 my ($db, $tbl, $user, @ids) = @_;
243 $db->do("LOCK TABLES $tbl WRITE");
244 del_song($db, $tbl, @ids);
245 my ($order) = $db->selectrow_array("SELECT MAX(song_order) FROM $tbl");
246 $order = 0 if $order < 0;
247 my $retval = add_song_nolock($db, $tbl, $order + 1, $user, @ids);
248 $db->do("UNLOCK TABLES");
252 sub reorder_table($$$@) {
253 my ($db, $tbl, $order, @ids) = @_;
256 $db->do("UPDATE $tbl SET song_order=$order WHERE song_id=$_");
261 sub move_song_to_top($$@) {
262 my ($db, $tbl, @ids) = @_;
264 $db->do("LOCK TABLES $tbl WRITE");
265 reorder_table($db, $tbl, $#ids + 2, get_table_ids($db, $tbl, "ORDER BY song_order"));
266 reorder_table($db, $tbl, 1, @ids);
267 $db->do("UNLOCK TABLES");
270 sub move_song_to_bottom($$@) {
271 my ($db, $tbl, @ids) = @_;
274 foreach(@ids) { $ids{$_} = 1; };
275 $db->do("LOCK TABLES $tbl WRITE");
276 my @q = get_table_ids($db, $tbl, "ORDER BY song_order");
279 if($ids{$_}) { push @q2, $_; } else { push @q1, $_; }
281 reorder_table($db, $tbl, 1, @q1, @q2);
282 $db->do("UNLOCK TABLES");
285 sub shuffle_table($$) {
288 $db->do("LOCK TABLES $tbl WRITE");
289 reorder_table($db, $tbl, 1, get_table_ids($db, $tbl, "ORDER BY rand()"));
290 $db->do("UNLOCK TABLES");
294 my ($user, $id) = @_;
295 my ($plid, $host, $port);
298 open F, $conf{statusfile}
299 or die "$conf{statusfile}: $!\n";
306 if(defined($id) && $id != $plid) { return undef; }
308 if($conf{kill_song_external}) {
309 system $conf{kill_song_external}, $user || '';
311 open F, $conf{statusfile}
312 or die "$conf{statusfile}: $!\n";
318 return kill_song_internal($host, $port);
321 sub kill_song_internal($$) {
322 my ($host, $port) = @_;
325 $host && $port or return undef;
327 socket(F, PF_INET, SOCK_STREAM, getprotobyname('tcp'))
328 or die "socket: $!\n";
329 connect(F, sockaddr_in($port, inet_aton($host)))
330 or die "connect $host:$port: $!\n";
342 open F, $conf{statusfile}
343 or die "$conf{statusfile}: $!\n";
348 my $sock = IO::Socket::INET->new("$host:2222") or return undef;
350 $response = <$sock>; #greeting
352 $sock->print("$_\n");
353 $res = 0 if <$sock> !~ /^\+/;
360 sub get_player_pid() {
364 open F, $conf{statusfile}
365 or die "$conf{statusfile}: $!\n";
373 my ($db, $table, $value) = @_;
375 my $sth = $db->prepare("SELECT id,name FROM $table WHERE binary name=?");
376 if($sth->execute($value || "") >= 1) {
377 my ($id, $v) = $sth->fetchrow_array;
380 $db->do("REPLACE INTO $table SET name=?", undef, $value)
382 return $db->{'mysql_insertid'};
386 sub get_playlist_contents($$) {
387 my ($dbh, $list) = @_;
389 my (%artistids, %albumsids, %listids);
390 my (%artistids_done, %albumsids_done, %listids_done);
392 my $sth_list = $dbh->prepare("SELECT type,entity_id" .
393 " FROM list_contents WHERE list_id=?");
394 my $sth_artist = $dbh->prepare("SELECT id FROM song WHERE artist_id=?");
395 my $sth_album = $dbh->prepare("SELECT id FROM song WHERE album_id=?");
398 while(%artistids || %albumsids || %listids) {
399 foreach(keys %listids) {
400 $listids_done{$_} = 1;
403 $sth_list->execute($_);
404 while($_ = $sth_list->fetchrow_hashref) {
405 if($_->{'type'} eq 'list') {
406 next if $listids_done{$_->{'entity_id'}};
407 $listids{$_->{'entity_id'}} = 1;
408 } elsif($_->{'type'} eq 'artist') {
409 next if $artistids_done{$_->{'entity_id'}};
410 $artistids{$_->{'entity_id'}} = 1;
411 } elsif($_->{'type'} eq 'album') {
412 next if $albumids_done{$_->{'entity_id'}};
413 $albumids{$_->{'entity_id'}} = 1;
414 } elsif($_->{'type'} eq 'song') {
415 $songids{$_->{'entity_id'}} = 1;
419 foreach(keys %artistids) {
420 $artistids_done{$_} = 1;
421 delete $artistids{$_};
423 $sth_artist->execute($_);
424 while($_ = $sth_artist->fetchrow_hashref) {
425 $songids{$_->{'id'}} = 1;
428 foreach(keys %albumids) {
429 $albumids_done{$_} = 1;
430 delete $albumids{$_};
432 $sth_album->execute($_);
433 while($_ = $sth_album->fetchrow_hashref) {
434 $songids{$_->{'id'}} = 1;
438 return keys %songids;
441 sub get_nowplaying(;$) {
446 open F, $conf{statusfile} or return undef;
447 chop (($s->{id}, $s->{filename}, $s->{pid}, $s->{cdrplaypid},
448 $s->{killhost}, $s->{killport}, $s->{type},
449 $s->{user}, $s->{artist}, $s->{title}, $s->{album},
450 $s->{track}, $s->{length}, $s->{encoding},
451 $s->{artisturl}, $s->{albumurl}, $s->{titleurl}) = <F>);
454 if($dbh && $s->{id}) {
455 my $sth = $dbh->prepare(
456 "SELECT artist.name as artist,album.name as album," .
457 " song.artist_id as arid,song.album_id as alid, song.*" .
458 " FROM song,artist,album WHERE song.artist_id=artist.id" .
459 " AND song.album_id=album.id AND song.id=?");
460 $sth->execute($s->{id});
461 if(my $d = $sth->fetchrow_hashref) {
462 $s->{alid} = $d->{alid};
463 $s->{arid} = $d->{arid};
464 $s->{filename} = $d->{filename};
465 $s->{artist} = $d->{artist};
466 $s->{title} = $d->{title};
467 $s->{album} = $d->{album};
468 $s->{track} = $d->{track};
469 $s->{length} = $d->{length};
470 $s->{encoding} = $d->{encoding};
476 sub construct_url($@) {
477 my ($baseurl, $argsref) = @_;
479 foreach(keys %$argsref) {
480 $baseurl .= "$sep$_=" . encurl($$argsref{$_});
489 $s =~ s/\.mp3\s*$//i;
490 $s =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eig;
491 $s =~ s/([a-zA-Z])([A-Z][a-z])/$1 $2/g;
494 if($s !~ / /) { $s =~ s/\./ /g; }
495 $s =~ s/^\s+|\s+$//g;
496 $s =~ s/([^'\w\xc0-\xff]|^)(\w)/$1\U$2/g;
497 $s =~ s/\b(o'\w)/\U$1/ig;
500 $s =~ s/\bI M\b/I'm/g;
501 $s =~ s/ ll\b/'ll/ig;
502 $s =~ s/\b(i+)\b/\U$1/ig;
503 $s =~ s/([eiuy]) ([rv]e)\b/$1'\L$2/ig;
504 $s =~ s/\s*-\s*/ - /g;
508 sub add_song_next($$$;$) {
509 my ($dbh, $table, $currentsong, $user) = @_;
511 my $ids = $dbh->selectcol_arrayref("SELECT song_id FROM $table,song ".
512 "WHERE $table.song_id=song.id AND song.present");
514 foreach(@$ids) { $idsq{$_} = 1; }
516 my $sth = $dbh->prepare("SELECT song2.* FROM song AS song1,".
517 " song AS song2 WHERE song1.id=$currentsong AND".
518 " song1.artist_id = song2.artist_id AND".
519 " song1.album_id = song2.album_id AND".
520 " song2.track > song1.track AND".
521 " song2.present ORDER BY song2.track");
523 while($_ = $sth->fetchrow_hashref) {
524 if(!$idsq{$_->{id}}) {
525 add_song($dbh, $table, $user, $_->{id})
526 or warn "can't add song.\n";
534 'abk' => 'Abkhazian',
538 'afa' => 'Afro-Asiatic',
540 'afr' => 'Afrikaans',
545 'alg' => 'Algonquian Languages',
547 'ang' => 'English, Old',
548 'apa' => 'Apache Languages',
552 'arn' => 'Araucanian',
554 'art' => 'Artificial',
557 'ath' => 'Athapascan Languages',
562 'aze' => 'Azerbaijani',
564 'bai' => 'Bamileke Languages',
573 'bel' => 'Byelorussian',
589 'bul' => 'Bulgarian',
592 'cai' => 'Central American Indian',
595 'cau' => 'Caucasian',
605 'chn' => 'Chinook jargon',
608 'chu' => 'Church Slavic',
614 'cpe' => 'Creoles and Pidgins, English-based',
615 'cpf' => 'Creoles and Pidgins, French-based',
616 'cpp' => 'Creoles and Pidgins, Portuguese-based',
618 'crp' => 'Creoles and Pidgins',
629 'dra' => 'Dravidian',
631 'dum' => 'Dutch, Middle',
636 'egy' => 'Egyptian (Ancient)',
638 'ell' => 'Greek, Modern',
641 'enm' => 'English, Middle',
642 'epo' => 'Esperanto',
655 'fiu' => 'Finno-Ugrian',
659 'frm' => 'French, Middle',
660 'fro' => 'French, Old',
664 'gae' => 'Gaelic (Scots)',
667 'gdh' => 'Gaelic (Scots)',
672 'gil' => 'Gilbertese',
674 'gmh' => 'German, Middle High',
675 'goh' => 'German, Old High',
679 'grc' => 'Greek, Ancient',
680 'gre' => 'Greek, Modern',
688 'hil' => 'Hiligaynon',
689 'him' => 'Himachali',
691 'hmo' => 'Hiri Motu',
692 'hun' => 'Hungarian',
697 'ice' => 'Icelandic',
699 'iku' => 'Inuktitut',
701 'ina' => 'Interlingua',
703 'ind' => 'Indonesian',
704 'ine' => 'Indo-European',
705 'ine' => 'Interlingue',
709 'iro' => 'Iroquoian uages',
710 'isl' => 'Icelandic',
715 'jpr' => 'Judeo-Persian',
716 'jrb' => 'Judeo-Arabic',
717 'kaa' => 'Kara-Kalpak',
720 'kal' => 'Greenlandic',
732 'kho' => 'Khotanese',
734 'kin' => 'Kinyarwanda',
756 'lit' => 'Lithuanian',
759 'ltz' => 'Letzeburgesch',
760 'lub' => 'Luba-Katanga',
764 'luo' => 'Luo (Kenya and Tanzania)',
765 'mac' => 'Macedonian',
770 'mak' => 'Macedonian',
772 'mal' => 'Malayalam',
775 'map' => 'Austronesian',
781 'mga' => 'Irish, Middle',
783 'min' => 'Minangkabau',
784 'mis' => 'Miscellaneous',
789 'mno' => 'Manobo Languages',
791 'mol' => 'Moldavian',
792 'mon' => 'Mongolian',
796 'mul' => 'Multiple Languages',
797 'mun' => 'Munda Languages',
801 'myn' => 'Mayan Languages',
803 'nai' => 'North American Indian',
806 'nbl' => 'Ndebele, South',
807 'nde' => 'Ndebele, North',
811 'nic' => 'Niger-Kordofanian',
814 'nno' => 'Norwegian (Nynorsk)',
815 'non' => 'Norse, Old',
816 'nor' => 'Norwegian',
817 'nso' => 'Sotho, Northern',
818 'nub' => 'Nubian Languages',
824 'oci' => 'Langue d\'Oc',
830 'ota' => 'Turkish, Ottoman',
831 'oto' => 'Otomian Languages',
832 'paa' => 'Papuan-Australian',
833 'pag' => 'Pangasinan',
837 'pap' => 'Papiamento',
839 'peo' => 'Persian, Old',
841 'phn' => 'Phoenician',
845 'por' => 'Portuguese',
846 'pra' => 'Prakrit uages',
847 'pro' => 'Provencal, Old',
850 'raj' => 'Rajasthani',
851 'rar' => 'Rarotongan',
853 'roh' => 'Rhaeto-Romance',
862 'sai' => 'South American Indian',
863 'sal' => 'Salishan Languages',
864 'sam' => 'Samaritan Aramaic',
867 'scr' => 'Serbo-Croatian',
870 'sga' => 'Irish, Old',
873 'sin' => 'Singhalese',
874 'sio' => 'Siouan Languages',
875 'sit' => 'Sino-Tibetan',
879 'slv' => 'Slovenian',
880 'smi' => 'Sami Languages',
887 'sot' => 'Sotho, Southern',
890 'srd' => 'Sardinian',
892 'ssa' => 'Nilo-Saharan',
918 'tog' => 'Tonga (Nyasa)',
919 'ton' => 'Tonga (Tonga Islands)',
921 'tsi' => 'Tsimshian',
932 'ukr' => 'Ukrainian',
934 'und' => 'Undetermined',
939 'vie' => 'Vietnamese',
942 'wak' => 'Wakashan Languages',
947 'wen' => 'Sorbian Languages',