package gdgentools;

##################################################
#
# GiantDisc mp3 Jukebox
# 
# © 2000, Rolf Brugger
#
##################################################



### General tool routines

use lib '/home/music/bin';
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{ 



############################################################
### parameter handling
# 
# the parameters in .gdconfig are read only once at the server start.
# to make them accesible to related processes (like gdplayd.pl) they
# are stored in the db-table 'parameter'
#
sub param_set {# returns true, if a parameter value is associated to $name
               # false otherwise
  my ($dbh, $playerid, $name) = @_;
  my $sth = $dbh->prepare( 
         "SELECT value FROM parameter WHERE playerid=$playerid AND name='$name'");
  my $nbrec = $sth->execute;

  my $exist = 0;
  if($row = $sth->fetchrow_hashref){
    $exist = 1;
  }
  $sth->finish;
  #print "RET-PARAMETER: does $name exist? '$exist'\n";
  return $exist;
}

sub param_value {# returns the parameter value that is associated to $name
                 # or the empty sting, if it doesn't exist
  my ($dbh, $playerid, $name) = @_;
  my $sth = $dbh->prepare( 
         "SELECT value FROM parameter WHERE playerid=$playerid AND name='$name'");
  my $nbrec = $sth->execute;

  my $value = "";
  if($row = $sth->fetchrow_hashref){
    $value = $row->{value};
  }
  $sth->finish;
  #print "RET-PARAMETER: $name='$value'\n";
  return $value;
}

sub param_set_value {# sets the parameter value
  my ($dbh, $playerid, $name, $value) = @_;
  my $sth = $dbh->do( 
         "REPLACE INTO parameter SET playerid=$playerid, name='$name', value='$value'");
}

sub param_remove {# removes the parameter (name and value)
  my ($dbh, $playerid, $name) = @_;
  my $sth = $dbh->do( 
         "DELETE FROM parameter WHERE playerid=$playerid AND name='$name'");
}





############################################################
### 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, $playerdevice) = @_; 
  $dbh->do("REPLACE INTO playerstate SET "
    ."playerid=$playerid, "
    ."audiochannel=$audiochannel, "
    ."playertype=$playertype, "
    ."snddevice='$playerdevice', "
    ."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,$playerdevice);

  if($row = $sth->fetchrow_hashref){
    $playertype = $row->{playertype};
    $playerhost = $row->{ipaddr};
    $playerdevice  = $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,$playerdevice);
}


# 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";

  if($row = $sth->fetchrow_hashref){
    $currtracknb = $row->{currtracknb};
    $state       = $row->{state};
    $framesplayed= $row->{framesplayed};
  }
  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);
}


# 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, $playerdevice);
  my $playertype = 0;
  my $playerhost = "localhost";
  my $playerdevice = "/dev/dsp";

  if($row = $sth->fetchrow_hashref){
    $playertype  = $row->{playertype};
    $playerhost  = $row->{ipaddr};
    $playerdevice= $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, $playerdevice);
}


# 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) = @_;
  if (length($currtracknb)==0){$currtracknb=0;}
  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_shufflestate{
  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");
}

# Returns the player parameter ($shufflepar)
sub pll_get_shufflestate{
  my ($dbh, $playerid, $audiochannel) = @_;
  my ($shufflepar, $shufflestat);
  my $sth = $dbh->prepare( 
  	 "SELECT * FROM playerstate WHERE playerid=$playerid AND audiochannel=$audiochannel" );
  my $nbrec = $sth->execute;
  if($row = $sth->fetchrow_hashref){
    $shufflepar   = $row->{shufflepar};
    $shufflestat  = $row->{shufflestat};
  }
  $sth->finish;
  return ($shufflepar, $shufflestat);
}


#######################################################################
### 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); # kill all processes related to gdplayd
        
        ### Enhancement by Stefan Leppert
        # Killing gdplayd.pl process before its subprocesses
        system "kill ".$chpids[0];

        # Now kill all subprocesses
        shift @chpids;
        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");

  #the perl modules 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) = 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) = 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) = 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);

  pll_save_resume($dbh, $playerid, $audiochannel);
}

sub pl_pause{
# stops playing and preserve playtime-state
  my ($dbh, $playerid, $audiochannel) = @_;
  my ($trackind, $state, $frame) = 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

  pll_save_resume($dbh, $playerid, $audiochannel);
}

sub pl_rw{
# similar as pause
  my ($dbh, $playerid, $audiochannel) = @_;
  my ($trackind, $state, $frame) = 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) = 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) = @_; # the new index (must be valid)
  
  stop_play_processes($dbh, $playerid, $audiochannel);

  my ($trackind, $state, $frame) = 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) = 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) = 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);
}

# Copies the playlist position, the current playtime and the shufle parameters 
# to the resume-fields of the table player.
# Parameters: played, total  (units: frames)
sub pll_save_resume{
  my ($dbh, $playerid, $audiochannel) = @_;

  # get the values
  my ($trackind, $state, $startframe) = gdgentools::pll_get_playstate($dbh, $playerid, $audiochannel);
  my ($shufflepar, $shufflestat) =      gdgentools::pll_get_shufflestate($dbh, $playerid, $audiochannel);

  #print "save resume data in player $playerid: $trackind, $startframe, $shufflepar, $shufflestat\n";
  # save them in the player 
  my $retval = $dbh->do(
  	 "UPDATE player SET "
  	."resumetracknb     = $trackind, "
  	."resumeplaytime    = $startframe, "
  	."resumeshufflepar  = '$shufflepar', "
  	."resumeshufflestat = '$shufflestat' "
  	."WHERE id=$playerid");
}

sub pll_get_resume{
  my ($dbh, $playerid) = @_;
  my ($trackind, $startframe, $shufflepar, $shufflestat);
  
  my $sth = $dbh->prepare("SELECT * FROM player WHERE id=$playerid");
  my $nbrec = $sth->execute;
  if($row = $sth->fetchrow_hashref){
    $trackind    = $row->{resumetracknb};
    $startframe  = $row->{resumeplaytime};
    $shufflepar  = $row->{resumeshufflepar};
    $shufflestat = $row->{resumeshufflestat};
  }
  $sth->finish;
  if (length($trackind)<1)  {$trackind=0;}
  if (length($startframe)<1){$startframe=0;}
  return ($trackind, $startframe, $shufflepar, $shufflestat);
}

sub pll_clear_resume{
  my ($dbh, $playerid) = @_;
  # clear resume info in the player 
  my $retval = $dbh->do(
  	 "UPDATE player SET "
  	."resumetracknb     = 0, "
  	."resumeplaytime    = 0, "
  	."resumeshufflepar  = '', "
  	."resumeshufflestat = '' "
  	."WHERE id=$playerid");
}


#######################################################################

### Playlog routines

sub log_trackid{
  ### writes the $trackid to the playlog
  ($dbh, $trackid) = @_;
  $dbh->do("INSERT INTO playlog SET trackid = $trackid, played = NOW() ");
}

sub log_current_track{
  ### writes the id of the current playlist track to the playlog
  ($dbh, $playerid, $audiochannel) = @_;
  my ($trackind, $state, $startframe) = gdgentools::pll_get_playstate($dbh, $playerid, $audiochannel);
  my $trackid = gdgentools::tracklist_get_item($dbh, $playerid, 0, $trackind);
  log_trackid($dbh, $trackid);
}


#######################################################################


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 an audio-file or an audio-stream?
sub is_mp3stream{
  my ($audiofilename) = @_;
  return ($audiofilename =~ /^[a-z]+:\/\/.*/);  # matches "http://", "rtsp://", "ftp://", ... at the beginning
}



############################################################
### 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_OBSOLETE{   # mp3info has been replaced by id3info
  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;
}


############################################################
# requires 'id3info' from id3lib package, http://id3lib.sourceforge.net/
sub get_id3info{ 
  my ($pattern, $filename) = @_;
  my $base = gdparams::gdbase();
  my $res = `id3info "$filename"`;
  my @resarr = split /\n/, $res;  
  
  my $line = shift(@resarr);
  while(defined($line)){
    if ($line =~ m/$pattern/){
      #print "MATCH: $line\n" ;
      #print "     : $1\n" ;
      return $1;
    }
    $line = shift(@resarr);
  }
}


############################################################
### 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


# changes by Gabriel Indurskis (gabindu):
# my ogginfo (v. 1.0) has some whitespace in front of the output,
# hence the grep patterns had to be changed accordingly
# I took the opportunity to use a similar design as for the mp3s,
# by defining a general function get_ogginfo:


# requires 'ogginfo'
sub get_ogginfo{ 
  my ($pattern, $filename) = @_;
  my $base = gdparams::gdbase();
  my $res = `ogginfo "$filename"`;
  my @resarr = split /\n/, $res;  
  
  my $line = shift(@resarr);
  while(defined($line)){
    # the /i makes search case-insensitive
    if ($line =~ m/$pattern/i){
      #print "MATCH: $line\n" ;
      #print "     : $1\n" ;
      return $1;
    }
    $line = shift(@resarr);
  }
}

# now for the case-by-case analysis, kept in separate functions so we
# can adjust them later in one place, if the format changes (again)

sub oggfile_title{
  my($audiofile) = @_;
  return get_ogginfo(".*TITLE=(.*)\$", $audiofile);
}
sub oggfile_artist{
  my($audiofile) = @_;
  return get_ogginfo(".*ARTIST=(.*)\$", $audiofile);
}
sub oggfile_album{
  my($audiofile) = @_;
  return get_ogginfo(".*ALBUM=(.*)\$" , $audiofile);
}
sub oggfile_year{
  my($audiofile) = @_;
  $line = get_ogginfo(".*DATE=(.*)\$", $audiofile);
  if ($line =~ /\D*(\d*).*/){
    return $1;
  }
  else {
    return 0;
  }
}

# ogginfo 1.0 seems to return lengths in the form "4m:34s"
# note that we specified case-insensitive search in get_ogginfo,
# so we'll match both length and LENGTH (or anything inbetween)
sub oggfile_lengthsec{
  my($audiofile) = @_;
  $line = get_ogginfo(".*LENGTH[=:] *(\\d*m:\\d*s).*\$", $audiofile);
  # ogginfo 1.0 seems to return lenghts in the form "4m:34s"
  my $pattern = "(\\d*)m:(\\d*)s";
 if ($line =~ m/$pattern/){
    return int($1*60+$2);
  }
  else {
    return 0;
  }
}
# ogginfo v1.0 gives the bitrate in kb/s
sub oggfile_bitrate{
  my($audiofile) = @_;
  $bitrate = get_ogginfo(".*nominal bitrate[=:] *(.*) kb.*\$", $audiofile);
  return int($bitrate); # just round it
}
sub oggfile_tracknumber{
  my($audiofile) = @_;
  $line = get_ogginfo(".*TRACKNUMBER[=:](\d*)\$", $audiofile);
  return int($line);
} 
sub oggfile_genre{
  my($audiofile) = @_;
  return get_ogginfo(".*GENRE[=:](.*)\$", $audiofile);
}
sub oggfile_comment{
  my($audiofile) = @_;
  return get_ogginfo(".*COMMENT[=:](.*)\$", $audiofile);
}

###~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);
    # match TIT2,TT2
    $title = get_id3info("=== T.?T2 \\(.*\\): (.*)\$", $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);
    # match TPE1,TP1
    $artist = get_id3info("=== TP.?1 \\(.*\\): (.*)\$", $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);
    # match TALB,TAL
    return get_id3info("=== TAL.? \\(.*\\): (.*)\$", $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);
    # match TYER,TYE
    return get_id3info("=== TYE.? \\(.*\\): (.*)\$", $audiofile);
  }
  elsif ($ftype eq "ogg"){
    return get_ogginfo(".*DATE=(.*)\$", $audiofile);
  }
  elsif ($ftype eq "flac"){
    return flacfile_year($audiofile);		###~CU~
  }
  else {
      # this used to be 1990 as a default value?!?
      # 0 makes more sense to me (G.I.), so you can actually see the missing entries
    return 0;
  }
}


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);
    # match Bitrate
    my $kbitrate = get_id3info("Bitrate: (\\d+)KBps", $audiofile);
    if ($kbitrate == 0){$kbitrate = 128;} # prevent from div by 0 if bitrate can't be detected - this should be replaced by a better estimation!
    $filesize = (-s "$audiofile");
    use integer;
    return $filesize*8/($kbitrate*1000);
  }
  elsif ($ftype eq "ogg"){
    return oggfile_lengthsec($audiofile);
  }
  elsif ($ftype eq "flac"){
    return flacfile_lengthsec($audiofile);	###~CU~
  }
  else {
    return 0;
  }
}


sub audiofile_bitrate{ # returns kBits per second, i.e. 128
  my($audiofile) = @_;   # must be full filename with path!
  my $ftype = audio_filetype($audiofile);
  if ($ftype eq "mp3"){
#    return get_mp3info("%r", $audiofile);
    # match Bitrate
    return get_id3info("Bitrate: (\\d+)KBps", $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);
    # match TRCK/TRK  (ex: match 4 or 4/9, return 4)
    $tracknb = get_id3info("=== TR.?K \\(.*\\): (\\d*)(\\/\\d*)?\$", $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);
    # match TCON/TCO
    # match "(13)"  or  "Pop"  or  "(13)Pop"
    $id3genre = get_id3info("=== TCO.? \\(.*\\): \\((\\d*)\\).*\$", $audiofile);
    if (length($id3genre) > 0){
      # genre number was matched
      return genre_id3togd($dbh, $id3genre);
    }
    else{
      $id3genre = get_id3info("=== TCO.? \\(.*\\): (.*)\$", $audiofile);
      # genre String was matched
      return genre_stringtogd($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 "";
  }
}


# added by Gabriel Indurskis (gabindu)
# extract the cddb out from a comment, stored in one of the following forms:
# "CDDB: ........", "CDDB: 0x........", "CDDB: xx........", "CDDB=........"
# spaces after the colon and upper/lower case of "CDDB" matter not
# we always return the 8-letter code, without the "0x" or "xx"
sub audiofile_cddbid{
  my($audiofile) = @_;   # must be full filename with path!
  my $ftype = audio_filetype($audiofile);
  my $cddbid="";

  # only for mp3 and ogg-files at the moment

  # note that since we have possibly several comments,
  # we need to look through all of them, not just the first comment

 if ($ftype eq "mp3"){
#      $cddbid = get_id3info("=== COMM \\(.*\\): \\(.*\\)\\[.*\\]: [Cc][Dd][Dd][Bb](?:[Ii][Dd])?[:=]? *(?:[0x]x)?(........)\$", $audiofile);
      return get_id3info(".*[Cc][Dd][Dd][Bb](?:[Ii][Dd])?[:=]? *(?:[0x]x)?(........)\$", $audiofile);
  }
  elsif ($ftype eq "ogg"){
      return get_ogginfo(".*CDDB(?:ID)?[:=]? *(?:[0x]x)?(........)\$", $audiofile);
  }
  
}


############################################################

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, $movefiles, $linkfiles) = @_;

  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);
    my $ripdir=get_ripdirectory(1000);
  
    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){
	    if ($movefiles){
		print "test: move '$fullpath/$sourcefile' to '$targetfile'\n";
	    }
	    else{
		if ($linkfiles){
		    print "test: link '$fullpath/$sourcefile' to '$targetfile'\n";
		}
		else{
		    print "test: copy '$fullpath/$sourcefile' to '$targetfile'\n";
		}
	    }
        }
        else{
	  # changed by Gabriel Indurskis (gabindu)
	    if ($movefiles){
		print "move '$fullpath/$sourcefile' to '$targetfile'\n";
		system "mv \"$fullpath/$sourcefile\" \"$targetfile\"";
	    }
	    else{
		if ($linkfiles){
		    print "link '$fullpath/$sourcefile' to '$targetfile'\n";
		    system "ln -s \"$fullpath/$sourcefile\" \"$targetfile\"";
		}
		else{
		    print "copy '$fullpath/$sourcefile' to '$targetfile'\n";
		    system "cp \"$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/_/;
  $str =~ tr/\\\/\:\*\?\<\>\|\"/_/;
  
  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;
#
