diff options
author | lvw <lvw@e10066b5-e1e2-0310-b819-94efdf66514b> | 2004-08-29 13:48:14 +0000 |
---|---|---|
committer | lvw <lvw@e10066b5-e1e2-0310-b819-94efdf66514b> | 2004-08-29 13:48:14 +0000 |
commit | e287c9b102fe10877f19f7b3c3e10c62209adbce (patch) | |
tree | 1b06a0f1b6d3bb6a071596e493ab44ab7e0c0e0c /scripts/gdgentools.pm | |
parent | 71a5323ca0e92000baaa4c276c3a6e2e734a607e (diff) | |
download | vdr-plugin-muggle-e287c9b102fe10877f19f7b3c3e10c62209adbce.tar.gz vdr-plugin-muggle-e287c9b102fe10877f19f7b3c3e10c62209adbce.tar.bz2 |
Removed GiantDisc scripts.
git-svn-id: https://vdr-muggle.svn.sourceforge.net/svnroot/vdr-muggle/trunk/muggle-plugin@125 e10066b5-e1e2-0310-b819-94efdf66514b
Diffstat (limited to 'scripts/gdgentools.pm')
-rwxr-xr-x | scripts/gdgentools.pm | 1606 |
1 files changed, 0 insertions, 1606 deletions
diff --git a/scripts/gdgentools.pm b/scripts/gdgentools.pm deleted file mode 100755 index aadc5c7..0000000 --- a/scripts/gdgentools.pm +++ /dev/null @@ -1,1606 +0,0 @@ -package gdgentools; - -################################################## -# -# GiantDisc mp3 Jukebox -# -# © 2000, Rolf Brugger -# -################################################## - - - -### General tool routines - -use lib '/home/lvw/Development/muggle-import/scripts'; -use gdparams; -use IO::Socket; - - -### Constants -my $pl_list = 0; # play list -my $rp_list = 1; # rip list -my $co_list = 2; # compression list -my $cr_list = 3; # cd recording list - - - - - -#use lib '/usr/local/bin'; -#BEGIN{;} -#END{;} - - -############################################################ -### Shuffle routine -sub fisher_yates_shuffle {# generate a random permutation of @array in place - my $array = shift; - my $i; - for ($i = @$array; --$i; ) { - my $j = int rand ($i+1); - next if $i == $j; - @$array[$i,$j] = @$array[$j,$i]; - } -} -# USAGE: -# fisher_yates_shuffle( \@array ); # permutes @array in placesub query_random_artists{ - - - - - -############################################################ -### barix exstreamer routines - -sub exstreamer_command{ - # sends a command string to the exstreamer at 'playerhost', without - # waiting for a result that is sent back by the exstreamer - - my ($playerhost, $command) = @_; - my $port = 12302; # default exstreamer tcp command port - my $sock = new IO::Socket::INET( PeerAddr => $playerhost, - PeerPort => $port, - Proto => 'tcp'); - die "Error: could not open socket $opt_h:$port. $!\n" unless $sock; - - ### send the command - print $sock $command."\n"; - close($sock); -} - - -sub exstreamer_command_res{ - # sends a command string to the exstreamer at 'playerhost'. - # It returns the first line that is sent back by the exstreamer (last \n chopped off) - - my ($playerhost, $command) = @_; - my $port = 12302; # default exstreamer tcp command port - my $sock = new IO::Socket::INET( PeerAddr => $playerhost, - PeerPort => $port, - Proto => 'tcp'); - die "Error: could not open socket $opt_h:$port. $!\n" unless $sock; - - ### send a command - print $sock $command."\n"; - my $res = <$sock>; - close($sock); - chop $res; - return $res; -} - - -############################################################ -### Playlist routines - - -# creates new playstate record. If one with the same playerid/audiochannel -# exists, it is overwritten. -sub pll_new_playstate{ - my ($dbh, $playerid, $audiochannel, $playertype, $snddevice, $playerapp, $playerparams, $ptlogger) = @_; - $dbh->do("REPLACE INTO playerstate SET " - ."playerid=$playerid, " - ."audiochannel=$audiochannel, " - ."playertype=$playertype, " - ."snddevice='$snddevice', " - ."playerapp='$playerapp', " - ."playerparams='$playerparams', " - ."ptlogger='$ptlogger', " - ."currtracknb=0, " - ."state='st', " # stopped - ."framesplayed=0, " - ."framestotal=0 " - ); -} - -# deletes playstate record -sub pll_del_playstate{ - my ($dbh, $playerid, $audiochannel) = @_; #parameters: database handle, player id, sound out it - $dbh->do("REPLACE FROM playerstate " - ."WHERE playerid=$playerid AND audiochannel=$audiochannel "); -} - - -# Returns th specified player-type -sub pll_get_playertype{ - my ($dbh, $playerid, $audiochannel) = @_; #parameters: database handle, player id, sound out it - - my $sth = $dbh->prepare( - "SELECT playertype,ipaddr,snddevice FROM player,playerstate " - ."WHERE player.id=playerstate.playerid " - ." AND player.id=$playerid " - ." AND playerstate.audiochannel=$audiochannel"); - - my $nbrec = $sth->execute; - #print("$nbrec playstates found (should be exactly 1)\n"); - - my ($playertype,$playerhost,$snddevice); - - if($row = $sth->fetchrow_hashref){ - $playertype = $row->{playertype}; - $playerhost = $row->{ipaddr}; - $snddevice = $row->{snddevice}; - } - else{ - ### This case should not happen! make the best out of it - print ("ERROR: can't get playertype for player $playerid channel $audiochannel\n"); - print (" no player/playerstate record found\n"); - } - $sth->finish; - - return ($playertype,$playerhost,$snddevice); -} - - -# Returns the current playstate -sub pll_get_playstate{ - my ($dbh, $playerid, $audiochannel) = @_; #parameters: database handle, player id, sound out it - - my $sth = $dbh->prepare( - "SELECT * FROM playerstate " - ."WHERE playerid=$playerid AND audiochannel=$audiochannel" ); - - my $nbrec = $sth->execute; - #print("$nbrec playstates found (should be exactly 1)\n"); - - my $currtracknb = 0; - my $state = "st"; - my $shufflestat = ""; - - if($row = $sth->fetchrow_hashref){ - $currtracknb = $row->{currtracknb}; - $state = $row->{state}; - $framesplayed= $row->{framesplayed}; - $shufflestat = $row->{shufflestat}; - } - else{ - ### This case should not happen! make the best out of it - #pll_new_playstate($dbh, $playerid, $audiochannel, "", "", ""); - print ("ERROR: can't get playstate for player $playerid channel $audiochannel\n"); - print (" no playerstate record found\n"); - } - $sth->finish; - - return ($currtracknb, $state, $framesplayed, $shufflestat); -} - - -# Returns -sub playerdefinition{ - my ($dbh, $playerid, $audiochannel) = @_; #parameters: database handle, player id, sound out it - - my $sth = $dbh->prepare( - "SELECT playertype, ipaddr, snddevice FROM player,playerstate " - ."WHERE player.id=$playerid AND playerstate.playerid=$playerid AND audiochannel=$audiochannel"); - - my $nbrec = $sth->execute; - #print("$nbrec playstates found (should be exactly 1)\n"); - - my ($playertype, $playerhost, $sounddevice); - my $playertype = 0; - my $playerhost = "localhost"; - my $sounddevice = "/dev/dsp"; - - if($row = $sth->fetchrow_hashref){ - $playertype = $row->{playertype}; - $playerhost = $row->{ipaddr}; - $sounddevice = $row->{snddevice}; - } - else{ - ### This case should not happen! - print ("ERROR: can't get player definition for player $playerid channel $audiochannel\n"); - print (" no playerstate record found\n"); - } - $sth->finish; - - return ($playertype, $playerhost, $sounddevice); -} - - -# Returns the process id of the player (that was previously stored in the DB) -sub pll_get_player_processid{ - my ($dbh, $playerid, $audiochannel) = @_; #parameters: database handle, player id, sound out it - my $sth = $dbh->prepare( - "SELECT processid FROM playerstate " - ."WHERE playerid=$playerid AND audiochannel=$audiochannel" ); - my $nbrec = $sth->execute; - my $playerpid = -1; - if($row = $sth->fetchrow_hashref){ - $playerpid = $row->{processid}; - } - else{ - ### This case should not happen! make the best out of it - print ("ERROR: can't get playstate for player $playerid channel $audiochannel\n no playerstate record found\n"); - } - $sth->finish; - return ($playerpid); -} - - - -# Writes the playstate to the playstate record -# Parameters: -# currtracknb -# state (one of: pl, st, in, ff, Ff, rw, Rw) [in=pause(interrupted)] -sub pll_write_playstate{ - my ($dbh, $playerid, $audiochannel, $currtracknb, $state) = @_; - my $retval = $dbh->do( - "UPDATE playerstate " - ."SET currtracknb=$currtracknb, state='$state' " - ."WHERE playerid=$playerid AND audiochannel=$audiochannel"); -} - - -# Writes the players process id to the playstate record -# The programs 'gdplayd.pl' and 'gdplaytmsim.pl' write their process id into -# the DB. This is necessary to efficiently stop playing or rewinding. -sub pll_write_player_processid{ - my ($dbh, $playerid, $audiochannel, $playerpid) = @_; - my $retval = $dbh->do( - "UPDATE playerstate " - ."SET processid=$playerpid " - ."WHERE playerid=$playerid AND audiochannel=$audiochannel"); -} - -#sub pll_clear_player_processid{ -# my ($dbh, $playerid, $audiochannel, $playerpid) = @_; -# if ($gdparms::multiclients){ -##print "clearing pid \n"; -# my $retval = $dbh->do( -# "UPDATE playerstate " -# ."SET processid=0 " -# ."WHERE playerid=$playerid AND audiochannel=$audiochannel"); -# } -#} - - -### Shuffle Play Parameters -sub pll_write_shuffleparameters{ - my ($dbh, $playerid, $audiochannel, $parameterstring, $statisticsstring) = @_; - print("writing shuffleparamstring: '$parameterstring'\n"); - my $retval = $dbh->do( - "UPDATE playerstate " - ."SET shufflepar =".$dbh->quote($parameterstring).", " - ." shufflestat=".$dbh->quote($statisticsstring)." " - ."WHERE playerid=$playerid AND audiochannel=$audiochannel"); -} - - - -####################################################################### -### Stop playing -# -# Stopping to play means killing the specifig playing-deamon 'gdplayd.pl' -# and all the sub-processes it has spawned. -# -# As long as only one instance of a GiantDisc server is running on a -# machine, we can just blindly kill all potentially spawned processes by -# name (see routine 'kill_all_play_processes'). -# -# If we have more than one server instance on the same machine, this blindly -# killing method doesn't work anymore. Stopping to play on one instance would -# terminate the play processes of all other server instances. It is therefore -# necessary to specifically kill the involved processes. I have tried many -# (really a lot of) approaches during 2 years - nothing really worked well. -# There were 2 main problems: -# - killing the processes was far too slow -# - multiple instances of gdplayd.pl and it sub-processes appeared leading -# to locked soundcards etc. ( This especially happened, when playing was -# quickly stopped and restarted, or after fast sequences of 'play next' -# commands. -# -# The currently adopted however method seems to work fine, it is robust and -# efficient enough. It is explained in detail below, see routines plmsg_... -# - - -### tested and not well working: Killall and Killfam! -### Comment: Proc::Killall is terribly slow (much slower than system("killall...")) -### using Proc::Killfam is unstable because of overlapping playing -### commands, that inevitably lead to multiple instances of gdplayd.pl -### (mainly because pid of gdplayd.pl is known too late?) -### Finally - Proc::Killfam is too slow too! - - -sub stop_play_processes{ - - my ($dbh, $playerid, $audiochannel) = @_; - my $new_kill_player = 1; -# if ($gdparms::multiclients){ - if ($new_kill_player){ - my $playerpid = pll_get_player_processid($dbh, $playerid, $audiochannel); - - if ($playerpid >0){ - ### get all child processes of $playerpid - my $chprocs = `pstree $playerpid -p |tr -d '\012'`; # get process id's, on one text line - my @chpids = split /\(/, $chprocs; - shift @chpids; # pop off first element - foreach $elem (@chpids){ - $elem =~ s/\).*//; - } - - if (scalar(@chpids)>0){ - #print " specifically killing ".join (",",@chpids)."\n"; - system "kill ".join (" ",@chpids); - } - } - } - else{ - kill_all_play_processes(); - } -} - - -sub kill_all_play_processes{ - #print "killing blindly\n"; - system("killall -q gdplayd.pl; " - ."killall -q mpg123; " - ."killall -q ogg123; " - ."killall -q flac; " - ."killall -q rawplay; " - ."killall -q gdplaytmsim.pl; " - ."killall -q gdstream.pl"); - - #killall and killfam are terribly slow! -} - - -####################################################################### -### IPC Message routines to make sure, that a stop operation really kills -# all player processes. -# Method: -# 1) the server starts the player 'gdplayd.pl' in background -# 2) right after starting gdplayd.pl, the server waits for a message of -# gdplayd.pl -# 3) in the init phase of gdplayd.pl, it writes it's own process-id to the -# database and sends then a message to the message queue -# 4) the server receives the message and can continue to process requests -# from the palm -# 5) when the server should now stop playing, it is 100% sure, that the -# correct process-id o the playing process is in the db. -# Killing it (and it's subprocesses) stops playing. - -use IPC::SysV qw(IPC_CREAT S_IRWXU ftok); -use IPC::Msg; - -# Die folgenden Konstanten kennzeichnen die Message-Queue im System. -# RENDEZVOUS muss der Name einer _existierenden_ Datei sein! -# Nur die unteren 8 Bits von RVID sind wichtig und muessen !=0 sein! -# ftok(RENDEZVOUS, RVID) erzeugt einen immer identischen Schluessel, -# so lange die Datei RENDEZVOUS nicht neu angelegt wurde. - -use constant RENDEZVOUS => "/etc"; -#use constant RVID => 121; - -sub rendevous_id{ - my ($playerid, $audiochannel) = @_; -#print "p=$playerid, chn=$audiochannel -> rdvid=".($playerid*16 + $audiochannel + 1)."\n"; - if ($playerid>15 || $audiochannel>15){ - print "\n WARNING:\n "; - print "too many palyers/audiochannels\n"; - print " p=$playerid, chn=$audiochannel -> rdvid=".($playerid*16 + $audiochannel + 1)."\n\n"; - } - return $playerid*16 + $audiochannel + 1; -} -sub plmsg_newqueue{ - ### creates messae queue RENDEVOUS, if it doesn't already exist - my ($playerid, $audiochannel) = @_; - my $rdvid = rendevous_id($playerid, $audiochannel); - use vars qw($msg); - $msg = new IPC::Msg(ftok(RENDEZVOUS, $rdvid), S_IRWXU | IPC_CREAT); - -} - -sub plmsg_send{ - ### appends a message to the queue - my ($playerid, $audiochannel) = @_; - my $rdvid = rendevous_id($playerid, $audiochannel); - my $msg = new IPC::Msg(ftok(RENDEZVOUS, $rdvid), 0); - my ($prio, $text)=(1,"player started");# = @MESSAGES[$i,$i+1]; - $msg->snd($prio, $text, 0); -} - -sub plmsg_waitrcv{ - my ($playerid, $audiochannel) = @_; - ### pulls one message from the message queue, waits until one message is there - my $rdvid = rendevous_id($playerid, $audiochannel); - my $msg = new IPC::Msg(ftok(RENDEZVOUS, $rdvid), 0); - my $buflen = 256; - $prio = $msg->rcv($buf, $buflen, 0, 0); -# print "Found: ($buf, $prio)\n"; -} - - -sub pl_start_playd_and_wait{ -# starts playing-deamon and waits until it has written it's pid in the db - my ($dbhost, $playerid, $audiochannel) = @_; -#print "--> start gdplayd.pl\n"; - system("gdplayd.pl $dbhost $playerid $audiochannel & "); -#print "--> wait for gdplayd.pl to be started\n"; - plmsg_waitrcv($playerid, $audiochannel); -#print "--> message received\n"; -} - - -####################################################################### -####################################################################### -# -# Basic Play Controls (also used as API) - - -sub pl_play{ -# starts playing - my ($dbh, $playerid, $audiochannel) = @_; - my ($trackind, $state, $frame, $shufflestat) = pll_get_playstate($dbh, $playerid, $audiochannel); - if(tracklist_get_item($dbh, $playerid, 0, $trackind) < 1){$trackind=1;} # playstate error - stop_play_processes($dbh, $playerid, $audiochannel); - pll_write_playstate($dbh, $playerid, $audiochannel, $trackind, "pl"); - pl_start_playd_and_wait($gdparms::dbhost, $playerid, $audiochannel); -# system("gdplayd.pl $gdparms::dbhost $playerid $audiochannel & "); -} - -sub pl_play_at{ -# starts playing at specified position (seconds) - my ($dbh, $playerid, $audiochannel, $songpos_sec) = @_; -# my ($songpos_sec) = @_; - my ($trackind, $state, $frame, $shufflestat) = pll_get_playstate($dbh, $playerid, $audiochannel); - if(tracklist_get_item($dbh, $playerid, 0, $trackind) < 1){$trackind=1;} # playstate error - stop_play_processes($dbh, $playerid, $audiochannel); - my $startframe = $songpos_sec * frames_per_second(); - pll_write_playtime_only($dbh, $playerid, $audiochannel, $startframe); - pll_write_playstate($dbh, $playerid, $audiochannel, $trackind, "pl"); - pl_start_playd_and_wait($gdparms::dbhost, $playerid, $audiochannel); -# system("gdplayd.pl $gdparms::dbhost $playerid $audiochannel & "); -} - -sub pl_stop{ -# stops playing and reset playtime-state - my ($dbh, $playerid, $audiochannel) = @_; - my ($trackind, $state, $frame, $shufflestat) = pll_get_playstate($dbh, $playerid, $audiochannel); - my($played, $total) = pll_get_playtime($dbh, $playerid, $audiochannel); - stop_play_processes($dbh, $playerid, $audiochannel); - pll_write_playstate($dbh, $playerid, $audiochannel, $trackind, "st"); - pll_write_playtime($dbh, $playerid, $audiochannel, 0, $total); -} - -sub pl_pause{ -# stops playing and preserve playtime-state - my ($dbh, $playerid, $audiochannel) = @_; - my ($trackind, $state, $frame, $shufflestat) = pll_get_playstate($dbh, $playerid, $audiochannel); - my($played, $total) = pll_get_playtime($dbh, $playerid, $audiochannel); - stop_play_processes($dbh, $playerid, $audiochannel); - pll_write_playstate($dbh, $playerid, $audiochannel, - $trackind, "in"); # state: interrupted -} - -sub pl_rw{ -# similar as pause - my ($dbh, $playerid, $audiochannel) = @_; - my ($trackind, $state, $frame, $shufflestat) = pll_get_playstate($dbh, $playerid, $audiochannel); - my ($played, $total) = pll_get_playtime($dbh, $playerid, $audiochannel); - stop_play_processes($dbh, $playerid, $audiochannel); - pll_write_playstate($dbh, $playerid, $audiochannel, - $trackind, "rw"); # state: rw - - ### continuously write current playtime to db (every second) - system("gdplaytmsim.pl $gdparms::dbhost $playerid $audiochannel & "); -} - -sub pl_ff{ -# similar as pause - my ($dbh, $playerid, $audiochannel) = @_; - my ($trackind, $state, $frame, $shufflestat) = pll_get_playstate($dbh, $playerid, $audiochannel); - my ($played, $total) = pll_get_playtime($dbh, $playerid, $audiochannel); - stop_play_processes($dbh, $playerid, $audiochannel); - pll_write_playstate($dbh, $playerid, $audiochannel, - $trackind, "ff"); # state: ff - - ### continuously write current playtime to db (every second) - system("gdplaytmsim.pl $gdparms::dbhost $playerid $audiochannel & "); -} - -sub pl_goto{ - ### makes a new track the current track - # sets the current playtime-posititon to zero - # the rest of the playstate is preserved - - use integer; - my ($dbh, $playerid, $audiochannel, $newind) = @_; -# my ($newind) = @_; # the new index (must be valid) - - stop_play_processes($dbh, $playerid, $audiochannel); - - my ($trackind, $state, $frame, $shufflestat) = pll_get_playstate($dbh, $playerid, $audiochannel); - pll_write_playstate($dbh, $playerid, $audiochannel, $newind, $state); - pll_write_playtime($dbh, $playerid, $audiochannel, 0, 0); - if($state eq "pl"){ # restart player - pl_start_playd_and_wait($gdparms::dbhost, $playerid, $audiochannel); -# system("gdplayd.pl $gdparms::dbhost $playerid $audiochannel & "); - } - else{ # new 'current' track: load it's total length - my $trackid = tracklist_get_item($dbh, $playerid, 0, $newind); - if (length($trackid)>0) { - my $sth = $dbh->prepare("SELECT * FROM tracks WHERE id = $trackid"); - my $cnt = $sth->execute; - if ($cnt > 0){ - my $row = $sth->fetchrow_hashref; - pll_write_playtime($dbh, $playerid, $audiochannel, 0, $row->{length}*frames_per_second()); - } - else{ - pll_write_playtime($dbh, $playerid, $audiochannel, 0, 0); - } - $sth->finish; - } - else{ - pll_write_playtime($dbh, $playerid, $audiochannel, 0, 0); - } - } -} - -sub pl_next{ - my ($dbh, $playerid, $audiochannel) = @_; - my ($trackind, $state, $frame, $shufflestat) = pll_get_playstate($dbh, $playerid, $audiochannel); - my $listlen = tracklist_get_nb_items($dbh, $playerid, $pl_list); - if ($trackind < $listlen) {$trackind++;} - pl_goto($dbh, $playerid, $audiochannel, $trackind); -} - -sub pl_prev{ - my ($dbh, $playerid, $audiochannel) = @_; - my $frames5sec = 5*frames_per_second(); # nb frames in 5 sec - my ($trackind, $state, $frame, $shufflestat) = pll_get_playstate($dbh, $playerid, $audiochannel); - my ($played, $total) = pll_get_playtime($dbh, $playerid, $audiochannel); - if ($trackind>0 && $played<$frames5sec){$trackind--;} - pl_goto($dbh, $playerid, $audiochannel, $trackind); -} - -####################################################################### -####################################################################### - - - - - -####################################################################### -# -# Playtime routines: -# The current position is always saved in the field 'framesplayed' -# If the player app can't continuously write this field, another realtime -# app has to write the current playtime (and ff, rew position) - -# mp3 constants -my $samplesPerFrame = 1152; -my $samplesPerSecond = 44100; - -sub frames_per_second{ - use integer; - return $samplesPerSecond/$samplesPerFrame; # = 38.281 -} -sub samples_per_frame{ - return $samplesPerFrame; -} -sub samples_per_second{ - return $samplesPerSecond; -} - - -# Writes the playtime to the playtime record. -# Parameters: played, total (units: frames) -sub pll_write_playtime{ - my ($dbh, $playerid, $audiochannel, $played, $total) = @_; - my $retval = $dbh->do( - "UPDATE playerstate " - ."SET framesplayed=$played, framestotal=$total " - ."WHERE playerid=$playerid AND audiochannel=$audiochannel"); -} - -sub pll_write_playtime_only{ # like pll_write_playtime without changing 'framestotal' - my ($dbh, $playerid, $audiochannel, $played) = @_; - my $retval = $dbh->do( - "UPDATE playerstate " - ."SET framesplayed=$played " - ."WHERE playerid=$playerid AND audiochannel=$audiochannel"); -} - - -# Returns the current playtime (frames played and total frames) -sub pll_get_playtime{ - my ($dbh, $playerid, $audiochannel) = @_; - my $played = 0; - my $total = 0; - - use integer; - - my $sth = $dbh->prepare( - "SELECT * FROM playerstate " - ."WHERE playerid=$playerid AND audiochannel=$audiochannel" ); - - my $nbrec = $sth->execute; - #print("$nbrec playtime found (should be exactly 1)\n"); - - if($row = $sth->fetchrow_hashref){ - $total = $row->{framestotal}; - $played = $row->{framesplayed}; - } - $sth->finish; - - return ($played, $total); -} - - -sub seconds_to_hm{ - my ($seconds) = @_; - my ($hours, $minutes); - use integer; # switch to int math - $hours = $seconds / 3600; - $minutes = ($seconds % 3600)/60; - return sprintf("%ih%02im", $hours, $minutes); -} - -sub seconds_to_sm{ - my ($seconds) = @_; - my ($minutes, $sec); - use integer; # switch to int math - $minutes = $seconds / 60; - $sec = $seconds % 60; - return sprintf("%i:%02i", $minutes, $sec); -} - - -### is the string a mp3-file or a mp3-stream? -sub is_mp3stream{ - my ($mp3filename) = @_; - return ($mp3filename =~ /^http:\/\/.*/); # matches "http://" at the beginning? -} - - -####################################################################### - -# Returns the player parameter ($snddevice, $playerapp, $playerparams, $ptlogger, $shufflepar) -sub pll_get_playparams{ - my ($dbh, $playerid, $audiochannel) = @_; - my ($snddevice, $playerapp, $playerparams, $ptlogger); - - my $sth = $dbh->prepare( - "SELECT * FROM playerstate " - ."WHERE playerid=$playerid AND audiochannel=$audiochannel" ); - my $nbrec = $sth->execute; - - if($row = $sth->fetchrow_hashref){ - $snddevice = $row->{snddevice}; - $playerapp = $row->{playerapp}; - $playerparams = $row->{playerparams}; - $ptlogger = $row->{ptlogger}; - $shufflepar = $row->{shufflepar}; - } - $sth->finish; - - return ($snddevice, $playerapp, $playerparams, $ptlogger, $shufflepar); -} - - -############################################################ -# Returns the main player parameters -# ($ipaddr, $uichannel, $logtarget, $cdripper, $mp3encoder, $cdromdev, $cdrwdev) -sub pll_get_mainparams{ - my ($dbh, $playerid) = @_; - my ($ipaddr, $uichannel, $logtarget, $cdripper, $mp3encoder, $cdromdev, $cdrwdev); - - my $sth = $dbh->prepare( - "SELECT * FROM player " - ."WHERE id=$playerid" ); - my $nbrec = $sth->execute; - - if($row = $sth->fetchrow_hashref){ - $ipaddr = $row->{ipaddr}; - $uichannel = $row->{uichannel}; - $logtarget = $row->{logtarget}; - $cdripper = $row->{cdripper}; - $mp3encoder= $row->{mp3encoder}; - $cdromdev = $row->{cdromdev}; - $cdrwdev = $row->{cdrwdev}; - } - $sth->finish; - - return ($ipaddr, $uichannel, $logtarget, $cdripper, $mp3encoder, $cdromdev, $cdrwdev); -} - - -############################################################ -### General tracklist functions (table tracklistitem) -# -# 'tracknb' always starts with 0 and is contiguous -# ex: 0,1,2,3 is legal, 0,1,2,4,5 is illegal -# - -sub tracklist_get_nb_items{ - # returns the of tracks in the specified tracklist - my ($dbh, $playerid, $listtype) = @_; - my $listlen = 0; - my $sth = $dbh->prepare( - "SELECT COUNT(*) FROM tracklistitem " - ."WHERE playerid=$playerid AND listtype=$listtype" ); - $sth->execute; - my @row; - if(@row = $sth->fetchrow_array){ - $listlen = $row[0]; - } - $sth->finish; - return $listlen; -} - -sub tracklist_append_list{ - # appends a list of trackid's to the specified tracklist. - # Parameters: dbh, playerid, listtype, trackids... - my ($dbh) = shift(@_); - my ($playerid) = shift(@_); - my ($listtype) = shift(@_); - - my $curritem = tracklist_get_nb_items($dbh, $playerid, $listtype); - - while($trackid = shift(@_)){ - $dbh->do("INSERT INTO tracklistitem SET " - ."playerid=$playerid, " - ."listtype=$listtype, " - ."tracknb=$curritem, " - ."trackid=$trackid "); - $curritem++; - } -} - - -# moves the specified list chunk down by one -sub tracklist_move_chunk_up{ - my ($dbh, $playerid, $listtype, $first, $last) = @_; - # "shift" specified items up (to higher index) by 1 - # have to do increment item by item because order is important - my $sth = $dbh->prepare( - "SELECT * FROM tracklistitem " - ."WHERE playerid=$playerid AND listtype=$listtype AND tracknb>=$first AND tracknb<=$last " - ."ORDER BY tracknb DESC" ); # order: highest index first! - $sth->execute; - my $row; - while($row = $sth->fetchrow_hashref){ - $dbh->do( - "UPDATE tracklistitem " - ."SET tracknb=tracknb+1 " - ."WHERE playerid=$playerid AND listtype=$listtype AND tracknb=".$row->{tracknb} ); - } - $sth->finish; -} - - -# removes the specified list item from the list (item index starts with 0) -sub tracklist_del_item{ - my ($dbh, $playerid, $listtype, $trackindex) = @_; - $dbh->do( - "DELETE FROM tracklistitem " - ."WHERE playerid=$playerid AND listtype=$listtype AND tracknb=$trackindex" ); - -### should write a routine 'tracklist_move_chunk_down' (like tracklist_move_chunk_up) - # "shift" following items down by 1 - # have to do decrement item by item because order is important - my $sth = $dbh->prepare( - "SELECT * FROM tracklistitem " - ."WHERE playerid=$playerid AND listtype=$listtype AND tracknb>$trackindex " - ."ORDER BY tracknb" ); - $sth->execute; - my $row; - while($row = $sth->fetchrow_hashref){ - $dbh->do( - "UPDATE tracklistitem " - ."SET tracknb=tracknb-1 " - ."WHERE playerid=$playerid AND listtype=$listtype AND tracknb=".$row->{tracknb} ); - } - $sth->finish; -} - -# removes the all list items from 0 to 'trackindex' -sub tracklist_del_upto_item{ - -### VERY INEFFICIENT IMPLEMENTATION!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - my ($dbh, $playerid, $listtype, $trackindex) = @_; - print("deleting up to $trackindex\n"); - my $counter=0; - while ($counter < $trackindex){ - tracklist_del_item($dbh, $playerid, $listtype, 0); - $counter++; - } -} - - -# reorders the specified list item in the list (item index starts with 0) -# -> 'destpos' must be lower than 'srcpos'! -sub tracklist_reorder_item{ - my ($dbh, $playerid, $listtype, $srcpos, $destpos) = @_; - - ### "move" src-item to a save location - my $savepos = -1000; # a bit too hacky? - $dbh->do( - "UPDATE tracklistitem " - ."SET tracknb=$savepos " - ."WHERE playerid=$playerid AND listtype=$listtype AND tracknb=$srcpos" ); - - # "shift" following items up by 1 - tracklist_move_chunk_up($dbh, $playerid, $listtype, $destpos, ($srcpos)-1); - - ### "move" src-item from save location to destination - $dbh->do( - "UPDATE tracklistitem " - ."SET tracknb=$destpos " - ."WHERE playerid=$playerid AND listtype=$listtype AND tracknb=$savepos" ); -} - - - -# empties the specified tracklist -sub tracklist_delete{ - my ($dbh, $playerid, $listtype) = @_; - $dbh->do( - "DELETE FROM tracklistitem " - ."WHERE playerid=$playerid AND listtype=$listtype" ); -} - - -# gets the trackid of the specified list item (item index starts with 0) -# If an error occurs, 0 is returned. -sub tracklist_get_item{ - my ($dbh, $playerid, $listtype, $trackindex) = @_; - my $trackid = 0; - my $sth = $dbh->prepare( - "SELECT * FROM tracklistitem " - ."WHERE playerid=$playerid AND listtype=$listtype AND tracknb=$trackindex" ); - my $nbrec = $sth->execute; - if($row = $sth->fetchrow_hashref){ - $trackid = $row->{trackid}; - } - $sth->finish; - return $trackid; -} - - -# Returns the current playlist (list of track ID's) -sub tracklist_get_all{ - my ($dbh, $playerid, $listtype) = @_; - my @playlist=(); - - my $sth = $dbh->prepare( - "SELECT * FROM tracklistitem " - ."WHERE playerid=$playerid AND listtype=$listtype " - ."ORDER BY tracknb" ); - my $nbrec = $sth->execute; - while($row = $sth->fetchrow_hashref){ - $trackid = $row->{trackid}; - push @playlist, $row->{trackid}; - } - $sth->finish; - - return @playlist; -} - - - -############################################################ -### id3tag functions - -### returns the value of a id3 tag or other mp3 parameters for the specified file -### Possible tagcodes are - -### NEW version: - -# %a Artist [string] -# %b Number of corrupt audio frames [integer] -# %c Comment [string] -# %C Copyright flag [string] -# %e Emphasis [string] -# %E CRC Error protection [string] -# %f Filename without the path [string] -# %F Filename with the path [string] -# %g Musical genre [string] -# %G Musical genre [integer] -# %l Album name [string] -# %L MPEG Layer [string] -# %m Playing time: minutes only [integer] -# %n Track [integer] -# %O Original material flag [string] -# %o Stereo/mono mode [string] -# %p Padding [string] -# %Q Sampling frequency in Hz [integer] -# %q Sampling frequency in KHz [integer] -# %r Bit Rate in KB/s (type and meaning -# affected by -r option) -# %s Playing time: seconds only [integer] -# (usually used in conjunction with # %m) -# %S Total playing time in seconds [integer] -# %t Track Title [string] -# %u Number of good audio frames [integer] -# %v MPEG Version [float] -# %y Year [string] -# %% A single percent sign - -sub get_mp3info{ - my ($tagcode, $filename) = @_; - my $base = gdparams::gdbase(); - my $res = `mp3info -p "$tagcode" "$filename"`; - - ### Error cases - if ($tagcode eq "%S" && length($res)==0){ - my $res2 = `mpg123 -v -t -n 0 "$filename" 2> $base/tmp/gdinfo.tmp;grep Frame $base/tmp/gdinfo.tmp`; - $res2 =~ m/.*\[(.+):(.+).(.+)\].*/; - my $min = $1; - my $sec = $2; - $res = $min*60 + $sec; - print("playlength fixed to $res\n"); - } - if($tagcode eq "%r" && ($res eq "Variable")) - { #check for Variable Bitrate -# $res="Var".`mp3info -p %r -r m "$filename"`; ### don't predeed wit 'wav' - it messes up bitrate calculations of streamer - $res=`mp3info -p %r -r m "$filename"`; - return $res; - } - if ($tagcode eq "%r" && ($res <= 0 )){ - $res = "128"; - } - - return $res; -} - - -############################################################ -### audio metadata with ogg support. -# -# standard ogg tags according to -# http://www.xiph.org/ogg/vorbis/doc/v-comment.html -# -> ARTIST TITLE ALBUM TRACKNUMBER YEAR GENRE COMMENT -# and - -### typical output of ogginfo -#>ogginfo file.ogg -#filename=file.ogg -# -#serial=6039 -#header_integrity=pass -#ALBUM=ob die Engel auch Beine haben -#TITLE=Die Schampullamaschine -#ARTIST=Zentriert ins Antlitz -#DATE=2002 -#TRACKNUMBER=7 -#GENRE=Industrial -#ORGANIZATION=- -#COMMENT=ZIA Ogg Vorbis 1.0 Final -#vendor=Xiph.Org libVorbis I 20020717 -#version=0 -#channels=2 -#rate=44100 -#bitrate_upper=none -#bitrate_nominal=128000 -#bitrate_lower=none -#stream_integrity=pass -#bitrate_average=126915 -#length=50.248005 -#playtime=0:50 -#stream_truncated=false -# -#total_length=50.248005 -#total_playtime=0:50 - -sub oggfile_title{ - my($audiofile) = @_; - $line = `ogginfo "$audiofile" |grep --ignore-case ^title=`; - chop $line; - return substr($line, 6); -} -sub oggfile_artist{ - my($audiofile) = @_; - $line = `ogginfo "$audiofile" |grep --ignore-case ^artist=`; - chop $line; - return substr($line, 7); -} -sub oggfile_album{ - my($audiofile) = @_; - $line = `ogginfo "$audiofile" |grep --ignore-case ^album=`; - chop $line; - return substr($line, 6); -} -sub oggfile_year{ - my($audiofile) = @_; - $line = `ogginfo "$audiofile" |grep --ignore-case ^date=`; - chop $line; - $line = substr($line, 5); - if ($line =~ /\D*(\d*).*/){ - return $1; - } - else { - return 0; - } -} -sub oggfile_lengthsec{ - my($audiofile) = @_; - $line = `ogginfo "$audiofile" |grep --ignore-case ^length=`; - chop $line; - my $lengthsec = substr($line, 7); - return int($lengthsec); -} -sub oggfile_bitrate{ - my($audiofile) = @_; - $line = `ogginfo "$audiofile" |grep --ignore-case ^bitrate_nominal=`; - chop $line; - my $bitrate = substr($line, 16); - return (int(($bitrate/4000)+0.5))*4; # round to modulo 4 -} -sub oggfile_tracknumber{ - my($audiofile) = @_; - $line = `ogginfo "$audiofile" |grep --ignore-case ^tracknumber=`; - chop $line; - $line = substr($line, 12); - return int($line); -} -sub oggfile_genre{ - return ""; -} - -###~CU~ #FLAC_BEGIN - -############################################################ -### FLAC metadata functions -### Autor: Christian Uebber -### -### Uses metaflac (see http://flac.sourceforge.net/) -### for extracting VORBIS_COMMENT metadata. -### -### Future versions may also support extracting -### cue-sheet information. -### - -sub flacfile_title{ - my($audiofile) = @_; - $line = `metaflac --show-vc-field=title "$audiofile"`; - chop $line; - return substr($line, 6); -} - -sub flacfile_artist{ - my($audiofile) = @_; - $line = `metaflac --show-vc-field=artist "$audiofile"`; - chop $line; - return substr($line, 7); -} -sub flacfile_album{ - my($audiofile) = @_; - $line = `metaflac --show-vc-field=album "$audiofile"`; - chop $line; - return substr($line, 6); -} - -sub flacfile_year{ - my($audiofile) = @_; - $line = `metaflac --show-vc-field=date "$audiofile"`; - chop $line; - $line = substr($line, 5); - if ($line =~ /\D*(\d*).*/){ - return $1; - } - else { - return 0; - } -} - -sub flacfile_lengthsec{ - my($audiofile) = @_; - $line = `metaflac --show-total-samples "$audiofile"`; - chop $line; - return int($line/44100); ## Please verify (theoretically correct) -} - -sub flacfile_bitrate{ - my($audiofile) = @_; - $line = `metaflac --show-sample-rate "$audiofile"`; - chop $line; - return (int($line/1000)); # respect maximum field length -# return ($line/1000); # respect maximum field length -# return (int($line)/100); # respect maximum field length -} - -### Alternative: -#sub flacfile_type{ -# my($audiofile) = @_; -# $line = `metaflac --show-sample-rate "$audiofile"`; -# chop $line; -# if ($line="44100"){ -# return "cda"; -# } -# else { -# return ""; -# } -#} - -sub flacfile_tracknumber{ - my($audiofile) = @_; - $line = `metaflac --show-vc-field=tracknumber "$audiofile"`; - chop $line; - $line = substr($line, 12); - return int($line); -} -sub flacfile_genre{ - my($audiofile) = @_; - $line = `metaflac --show-vc-field=genre "$audiofile"`; - chop $line; - return substr($line, 6); -} - -sub flacfile_tracknumber{ - my($audiofile) = @_; - $line = `metaflac --show-vc-field=tracknumber "$audiofile"`; - chop $line; - $line = substr($line, 12); - return int($line); -} - -###~CU~ #FLAC_END - -############################################################ - -sub audiofile_title{ - my($audiofile) = @_; # must be full filename with path! - my $ftype = audio_filetype($audiofile); - my $title = ""; - if ($ftype eq "mp3"){ - $title = get_mp3info("%t", $audiofile); - } - elsif ($ftype eq "ogg"){ - $title = oggfile_title($audiofile); - } - elsif ($ftype eq "flac"){ ###~CU~ - $title = flacfile_title($audiofile); - } - - if (length($title) > 0){ - return $title; - } - else { - use File::Basename; - return basename($audiofile); - } -} - - -sub audiofile_artist{ - my($audiofile) = @_; # must be full filename with path! - my $ftype = audio_filetype($audiofile); - my $artist = ""; - if ($ftype eq "mp3"){ - $artist = get_mp3info("%a", $audiofile); - } - elsif ($ftype eq "ogg"){ - $artist = oggfile_artist($audiofile); - } - elsif ($ftype eq "flac"){ - $artist = flacfile_artist($audiofile); ###~CU~ - } - - if (length($artist) > 0){ - return $artist; - } - else { - use File::Basename; - return basename($audiofile); - } -} - - -sub audiofile_album{ - my($audiofile) = @_; # must be full filename with path! - my $ftype = audio_filetype($audiofile); - if ($ftype eq "mp3"){ - return get_mp3info("%l", $audiofile); - } - elsif ($ftype eq "ogg"){ - return oggfile_album($audiofile); - } - elsif ($ftype eq "flac"){ - return flacfile_album($audiofile); ###~CU~ - } - else { - return "Album name"; - } -} - - -sub audiofile_year{ - my($audiofile) = @_; # must be full filename with path! - my $ftype = audio_filetype($audiofile); - if ($ftype eq "mp3"){ - return get_mp3info("%y", $audiofile); - } - elsif ($ftype eq "ogg"){ - return oggfile_year($audiofile); - } - elsif ($ftype eq "flac"){ - return flacfile_year($audiofile); ###~CU~ - } - else { - return 1990; - } -} - - -sub audiofile_lengthsec{ - my($audiofile) = @_; # must be full filename with path! - my $ftype = audio_filetype($audiofile); - if ($ftype eq "mp3"){ - return get_mp3info("%S", $audiofile); - } - elsif ($ftype eq "ogg"){ - return oggfile_lengthsec($audiofile); - } - elsif ($ftype eq "flac"){ - return flacfile_lengthsec($audiofile); ###~CU~ - } - else { - return 0; - } -} - - -sub audiofile_bitrate{ - my($audiofile) = @_; # must be full filename with path! - my $ftype = audio_filetype($audiofile); - if ($ftype eq "mp3"){ - return get_mp3info("%r", $audiofile); - } - elsif ($ftype eq "ogg"){ - return oggfile_bitrate($audiofile); - } - elsif ($ftype eq "flac"){ - return flacfile_bitrate($audiofile); # ###~CU~ flac: return sampling rate / please check alternative - } - else { - return 128; - } -} - - -sub audiofile_tracknumber{ - my($audiofile, $default_tracknb) = @_; # must be full filename with path! - my $ftype = audio_filetype($audiofile); - my $tracknb=0; - if ($ftype eq "mp3"){ - $tracknb = get_mp3info("%n", $audiofile); - } - elsif ($ftype eq "ogg"){ - $tracknb = oggfile_tracknumber($audiofile); - } - elsif ($ftype eq "flac"){ - $tracknb = flacfile_tracknumber($audiofile); - } - - if($tracknb > 0){ - return $tracknb; - } - else { - return $default_tracknb; - } -} - - -sub audiofile_genre{ - ### extracts id3 gerne code or genre string (depends on filetype) - ### returns GD-genre code - my($dbh, $audiofile) = @_; # must be full filename with path! - my $ftype = audio_filetype($audiofile); - if ($ftype eq "mp3"){ - my $id3genre = get_mp3info("%G", $audiofile); - return genre_id3togd($dbh, $id3genre); - } - elsif ($ftype eq "ogg"){ - my $genrestring = oggfile_genre($audiofile); - return genre_stringtogd($dbh, $genrestring); - } - elsif ($ftype eq "flac"){ - my $genrestring = flacfile_genre($audiofile); - return genre_stringtogd($dbh, $genrestring); - } - else { - return ""; - } -} - - -############################################################ - -sub audio_filetype{ - ### the filetype is derived form the filename extension - my($audiofile) = @_; - - if ($audiofile =~ /[Mm][Pp]3$/){ - return "mp3"; - } - if ($audiofile =~ /ogg$/){ - return "ogg"; - } - if ($audiofile =~ /flac$/){ - return "flac"; - } -} - - - -############################################################ - -sub get_bitrate_str{ - # returns format/bitrate in kBit/s (ex. "mp3 128", "ogg 112") - # takes as argument the audio file name with its full path. - my ($audiofile) = @_; - my $bitrate = audiofile_bitrate($audiofile); - my $ftype = audio_filetype($audiofile); - return "$ftype $bitrate"; -} - -sub bitrate_str_to_format_param{ - # gets a bitrate string like "mp3 128" and returns array ("mp3", "128") - my ($bitratestr) = @_; - my ($audiofmt, $audioparam) = split ' ', $bitratestr; # split "mp3 128" - if (length($audiofmt)<2){ # something went wrong - $audiofmt = "mp3"; # set reasonable default values - $audioparam = 128; - } - return ($audiofmt, $audioparam); -} - - -sub get_full_audiofile_path{ - # returns the full path of an audio file in a 00, 01, 02, ... directory - # or an empty string if the file doesn't exist - my ($audiofile) = @_; - my $base = gdparams::gdbase(); - my $fname = `ls $base/[0-9][0-9]/$audiofile`; # get full path - chop($fname); - return $fname; -} - -############################################################ -### Returns the first music directory with enough space - # to save ripped files. If no large enough directory is found - # an empty string is returned. - # Parameter: minimum free space in Mbytes - -sub get_ripdirectory{ - my ($minfreeMbytes) = @_; - my $base = gdparams::gdbase(); - - ### Get mp3 directories - my @mdir = gdparams::mp3dirs(); - - ### Get an mp3 directory with enough space left (1GB) - my $i=0; - my @dfres; - my $mbfree; - my $ripdir=""; - - while($i < @mdir){ - if (-d "$base/$mdir[$i]"){ - @dfres = split / +/, `df -m $base/$mdir[$i]|tail -1`; - $mbfree = $dfres[3]; - #print "$base/$mdir[$i] has $mbfree MB free \n"; - if($mbfree > $minfreeMbytes){ - $ripdir = $mdir[$i]; - last; # break - } - } - else{print "$base/$mdir[$i] is not a directory or does not exist\n";} - $i++; - } - #print("Rip directory: $ripdir \n"); - return $ripdir; -} - - -############################################################ -### import booklet/cover images -sub import_cover_images{ - # imports the jpeg images in a directory and associates them to an album - # the images are imported in lexical order. - # Naming scheme: trxx(cd-id)-(num).jpg, where num is an automatically - # incremented counter. The file imgxx(cd-id)-00.jpg is the front cover, - # the other are the following pages in a booklet. - - # Parameters: 1) dbh, - # 2) full directory path, - # 3) cd-id (like 0x10ac77e0, xx00001496) - # 4) test? (if set to 1, only show what would be done) - - my ($dbh, $fullpath, $cdid, $test) = @_; - - my ($sourcefile, $targetfile); - my $base = gdparams::gdbase(); - print "import images at $fullpath for id $cdid\n"; - - if (length($cdid)<10){ - print "Error (import_cover_images): illegal format of cdid '$cdid'\n"; - return; - } - - opendir INBOX, "$fullpath"; - my @imgfilelist = sort (grep /\.jpg$/, readdir INBOX); - closedir INBOX; - - #print "imgs: ".join (":",@imgfilelist)."\n"; - if (scalar(@imgfilelist) > 0){ - - ### Get a directory with enough space left (1GB) - my $ripdir=get_ripdirectory($gdparams::minfreehdspace); - - if($ripdir ne ""){### put image-file in music directory - my $imgnum = 0; - - foreach $sourcefile (@imgfilelist){ - $targetfile = sprintf ("$base/$ripdir/img%s-%02ld.jpg", $cdid, $imgnum); - if ($test){ - print "test: move '$fullpath/$sourcefile' to '$targetfile'\n"; - } - else{ - print "move '$fullpath/$sourcefile' to '$targetfile'\n"; - system "mv \"$fullpath/$sourcefile\" \"$targetfile\""; - if ($imgnum == 0){ - - my $sqlcmd = ("UPDATE album SET coverimg='img$cdid-00.jpg' WHERE cddbid = SUBSTRING('$cdid',3)"); - #print"\$dbh->do($sqlcmd);\n" - $dbh->do($sqlcmd); - } - } - $imgnum += 1; - }# end foreach - } - else{ - print("Not enough space left on disc \n"); - } - } - else{ - print "no jpeg images found in $fullpath \n"; - } -} - - -############################################################ -### common tool routines - -### returns highest number of imported (=not recorded from audio-CD, =no -### CDDB-ID associated) mp3 tracks. -### Parameter: database handle. -sub last_imported_tracknb{ - my ($dbh) = @_; - - my $mp3num; - my $trkseth = $dbh->prepare('select mp3file from tracks '. # get last record - 'where mp3file like "trxx________%" order by mp3file desc limit 1'); -# 'where mp3file like "trxx%" order by mp3file desc limit 1'); - my $nbmp3files = $trkseth->execute; - if ($nbmp3files > 0){ - $tracks = $trkseth->fetchrow_hashref; - $tracks->{mp3file} =~ m/trxx([0-9]*)\.\w/; # extract number - $mp3num = $1; - } - else{ - $mp3num = 0; - } - $trkseth->finish; - return $mp3num; -} - - -### Translates an id3 genre (numeric) to a GiantDisc genre code (string) -### Parameters: database handle, id3-genre. -### Returns: GiantDisc genre code (or empty string, if no match found) -sub genre_id3togd{ - my ($dbh, $id3genre)= @_; - - my $gdcode = ""; - if(length($id3genre)>0 && $id3genre >= 0){ - my $genseth = $dbh->prepare('select * from genre where id3genre="'. $id3genre . '" '); - my $nbgenres = $genseth->execute; - if ($nbgenres > 0){ - my $genres = $genseth->fetchrow_hashref; - $gdcode = $genres->{id}; - } - $genseth->finish; - } - #print("Translating id3:\"$id3genre\" to gdgenre \"$gdcode\" \n\n"); - return $gdcode; -} - -### Translates a genre string to a GiantDisc genre code (string) -### Parameters: database handle, genre string. -### Returns: GiantDisc genre code (or empty string, if no match found) -sub genre_stringtogd{ - my ($dbh, $genrestring)= @_; - - my $gdcode = ""; - if(length($genrestring)>0){ - my $genseth = $dbh->prepare( # get best=shortest match - "SELECT id,length(genre) AS len FROM genre " - ."WHERE genre like \"%".$genrestring."%\" ORDER BY len"); -# 'select id, from genre where genre="'. $genrestring . '" '); - my $nbgenres = $genseth->execute; - if ($nbgenres > 0){ - my $genres = $genseth->fetchrow_hashref; - $gdcode = $genres->{id}; - } - $genseth->finish; - } - #print("Translating genrestring:\"$genrestring\" to gdgenre \"$gdcode\" \n\n"); - return $gdcode; -} - - - -############################################################################### - -sub iso2ascii{ - # converts all non-ascii characters in the passed string as good - # as possible to ascii characters, and returns the result - - my ($str) = @_; - - $str =~ tr/\xc0-\xc6/A/; - $str =~ tr/\xc7/C/; - $str =~ tr/\xc8-\xcb/E/; - $str =~ tr/\xcc-\xcf/I/; - $str =~ tr/\xd0\xd1/DN/; - $str =~ tr/\xd2-\xd8/O/; - $str =~ tr/\xd9-\xdc/U/; - $str =~ tr/\xdd\xde\xdf/YTs/; - - $str =~ tr/\xe0-\xe6/a/; - $str =~ tr/\xe7/c/; - $str =~ tr/\xe8-\xeb/e/; - $str =~ tr/\xec-\xef/i/; - $str =~ tr/\xf0\xf1/dn/; - $str =~ tr/\xf2-\xf8/o/; - $str =~ tr/\xf9-\xfc/u/; - $str =~ tr/\xfd\xfe\xff/yts/; - - $str =~ tr/\xa0-\xff/_/; - - return $str; -} - -sub ascii2filename{ - # converts all ascii characters in the passed string as good - # as possible to ascii characters that are allowed in filenames, - #and returns the result - - my ($str) = @_; - - $str =~ tr/\//-/; # translate / to - - $str =~ tr/\x2f/_/; - $str =~ s/"/''/g; - - return $str; -} - -############################################################################### - - -1; -# |