MusicRoom - Software for managing digital music

    perldoc MusicRoom

package MusicRoom;

use warnings;
use strict;

our $VERSION = '0.40';

use Carp;
use Cwd;
use IO::File;
use DBI;

my($phase,%config,$dir,$conf_file);
my(%databases);

use constant MUSICROOM_DIR => "MUSICROOM_DIR";
use constant MUSICROOM_CONF => "musicroom.conf";
use constant MUSICROOM_VERSION => "0.01";

# This would turn on tracing in the DBI code
# DBI->trace(2);

$phase = "configure";
read_conf();

# All these need the configuration to be loaded first, so they 
# have to be "required" after the read_conf()
require MusicRoom::File;
require MusicRoom::Date;
require MusicRoom::LogicalModel;
require MusicRoom::Text::CSV;
require MusicRoom::Text::Nearest;
require MusicRoom::STN;
require MusicRoom::CoverArt;
require MusicRoom::Lyrics;
require MusicRoom::Charts;

sub is_running
  {
    return "" if($phase eq "configure");
    return 1;
  }

sub check_ready
  {
    if($phase eq "configure")
      {
        croak("Must configure MusicRoom before using it, run setup.pl");
      }
    if($phase ne "active")
      {
        croak("Phase has bad value in MusicRoom");
      }
  }

sub read_conf
  {
    # We can only call this once
    if($phase ne "configure")
      {
        carp("Can only call MusicRoom::init() at startup");
        return;
      }

    croak("Must set environment variable MUSICROOM_DIR to use MusicRoom")
                                            if(!defined $ENV{MUSICROOM_DIR});

    $dir = $ENV{MUSICROOM_DIR};

    # If we are on Windows then switch over to using / not \
    $dir =~ s/\\/\//g;

    $dir .= "/" if(!($dir =~ m#/$#));
    $conf_file = $dir.MUSICROOM_CONF;

    # If the configuration file has not yet been created we must 
    # wait for it to be set up
    return if(!-r $conf_file);

    # Read values into the config hash
    my $fh = IO::File->new($conf_file);
    croak("Cannot read $config{config_file}\n") 
                                                    if(!defined $fh);
    my $got_version = "";

    while(my $line = <$fh>)
      {
        chomp $line;
        $line =~ s/\cZ//g;
        next if($line =~ /^\s*$/);
        next if($line =~ /^\s*#/);
        if($line =~ /^\s*(version)\s*\=\s*\"([^\"]*)\"/)
          {
            $config{version} = $2;
            $got_version = 1;
            croak("Configuration is for wrong version ($config{version} not ".
                      MUSICROOM_VERSION.")") if($config{version} ne MUSICROOM_VERSION);
          }
        if($line =~ /^\s*(\w+)\s*\=\s*\"([^\"]*)\"/)
          {
            $config{$1} = $2;
          }
        elsif($line =~ /^\s*(\w+)\s*\=\s*\'([^\']*)\'/)
          {
            $config{$1} = $2;
          }
        elsif($line =~ /^\s*(\w+)\s*\=\s*\|([^\|]*)\|/)
          {
            $config{$1} = $2;
          }
        elsif($line =~ /^\s*(\w+)\s*\=\s*\/([^\/]*)\//)
          {
            $config{$1} = $2;
          }
        elsif($line =~ /^\s*(\w+)\s*\=\s*(\S.+)/)
          {
            $config{$1} = $2;
          }
        else
          {
            carp("Cannot parse config file \"$line\"");
          }
      }
    $fh->close();

    croak("Missing version spec in file")
                                 if(!$got_version);
    open_database("core");
    $phase = "active";
  }

sub configure
  {
    # This is where we store the config, the values set here are the ones 
    # we need to get to the config file
    croak("The MusicRoom system is already configured")
                             if($phase ne "configure");

    croak("Cannot find directory $dir (from \$MUSICROOM_DIR)")
                             if(!-d $dir);

    croak("Do not have permission to write to $dir")
                             if(!-w $dir);

    croak("File $conf_file already exists")
                             if(-r $conf_file);

    my %config_vars =
      (
        # Setting a default_value and read_only is a good way 
        # to nail a config var value
        version => 
          {
            default_value => MUSICROOM_VERSION,
          },
        data_location_file => 
          {
            default_value => ".musicroom_dir",
          },
        db_type =>  
          {
            default_value => "SQLite",
          },
        core_db_name =>  
          {
            default_value => "mrm_core.dat",
          },
        coverart_subdir =>
          {
            default_value => "art",
          },
        lyrics_subdir =>
          {
            default_value => "lyrics",
          },
        tools_dir =>  
          {
            configure => \&configure_var,
            name => "Path to directory containing format conversion tools",
            after_set_fun => sub
              {
                # Convert to absolute path if it was relative
              },
          },
        room_name =>  
          {
            configure => \&configure_var,
            name => "Music Library Name",
            value_type => "text",
          },
        object_file =>
          {
            # Definitions for the database objects
            name => "Object Definition File",
            value_type => "text",
          },
        wav_disabled =>
          {
            default_value => "",
          },
        mp3_disabled =>
          {
            default_value => "",
          },
      );
    
    foreach my $var (keys %config_vars)
      {
        next if(!defined $config_vars{$var}->{default_value});
    
        &{$config_vars{$var}->{before_set_fun}}($var)
                   if(defined $config_vars{$var}->{before_set_fun});
        $config{$var} = $config_vars{$var}->{default_value};
        &{$config_vars{$var}->{after_set_fun}}($var)
                   if(defined $config_vars{$var}->{after_set_fun});
      }

    local($|);

    $|=1;
    my $called_one;
    foreach my $var (sort keys %config_vars)
      {
        if(defined $config_vars{$var}->{configure})
          {
            print "MusicRoom needs to be configured\n"
                                 if(!defined $called_one);
            $called_one = 1;
            &{$config_vars{$var}->{configure}}($var,%config_vars);
          }
      }

    save_conf();
    create_database("core");

    # Now that we are ready to go lets get started
    read_conf();
  }

sub set_conf
  {
    my($var,$val) = @_;

    check_ready();
    # Set and save into the file
    if(!defined $config{$var})
      {
        carp("Cannot set configuration var \"$var\"");
        return undef;
      }

    # Check that the value can be written into the file
    if($val =~ /\"/ && $val =~ /\'/ && $val =~ /\|/ && $val =~ /\//)
      {
        carp("Cannot have <\"> and <\'> and <\|> and <\/> in single conf value");
        $val =~ s/\|/!/g;
      }
    $config{$var} = $val;
    save_conf();
  }

sub get_conf
  {
    my($var,$silent) = @_;
    # Get the value
    check_ready();

    # Magic value to get to the directory
    return $dir
             if(lc($var) eq "dir");

    # Look up in the configuration
    if(!defined $config{$var})
      {
        carp("No value for configuration var \"$var\"") 
                              if(!defined $silent || !$silent);
        return undef;
      }
    return $config{$var};
  }

sub read_config
  {
    croak("Cannot find $conf_file")
                     if(!-r $conf_file);

    # Read values into the config hash
    my $fh = IO::File->new($conf_file);
    croak("Cannot read $conf_file\n") 
                                                    if(!defined $fh);
    while(my $line = <$fh>)
      {
        chomp $line;
        $line =~ s/\cZ//g;
        next if($line =~ /^\s*$/);
        next if($line =~ /^\s*#/);
        if($line =~ /^\s*(\w+)\s*\=\s*\"([^\"]*)\"/)
          {
            $config{$1} = $2;
          }
        elsif($line =~ /^\s*(\w+)\s*\=\s*\'([^\']*)\'/)
          {
            $config{$1} = $2;
          }
        elsif($line =~ /^\s*(\w+)\s*\=\s*\|([^\|]*)\|/)
          {
            $config{$1} = $2;
          }
        elsif($line =~ /^\s*(\w+)\s*\=\s*\/([^\/]*)\//)
          {
            $config{$1} = $2;
          }
        elsif($line =~ /^\s*(\w+)\s*\=\s*(\S.+)/)
          {
            $config{$1} = $2;
          }
        else
          {
            carp("Cannot parse config file \"$line\"");
          }
      }
    $fh->close();
  }

sub save_conf
  {
    my $fh = IO::File->new(">$conf_file");
    if(!defined $fh)
      {
        croak("Cannot write to $conf_file");
      }

    my $date_str = MusicRoom::Date::text(undef);
    print $fh <<"EndHeader";
# Configuration file for MusicRoom
#     Saved: $date_str
#   Program: $0
#
EndHeader
    foreach my $key (sort keys %config)
      {
        my $val = $config{$key};

        if(!($val =~ /\"/))
          {
            print $fh "$key=\"$val\"\n";
          }
        elsif(!($val =~ /\'/))
          {
            print $fh "$key=\'$val\'\n";
          }
        elsif(!($val =~ /\|/))
          {
            print $fh "$key=\|$val\|\n";
          }
        elsif(!($val =~ /\//))
          {
            print $fh "$key=\/$val\/\n";
          }
        else
          {
            carp("Bad setting for $key ($val)");
          }
      }
    $fh->close();
  }

sub configure_var
  {
    my($var,%config_vars) = @_;

    if(!defined $var)
      {
        carp("configure_var called without variable name");
        return;
      }
    elsif(!defined $config_vars{$var})
      {
        carp("Attempt to configure unknown var $var");
        return;
      }
    elsif(!defined $config_vars{$var}->{value_type} ||
                   $config_vars{$var}->{value_type} eq "text")
      {
        my $name = $config_vars{$var}->{name};
        $name = $var if(!defined $name);
        print "Define a value for \"$name\": ";
        my $val = <>;
        chomp $val;
        $config{$var} = $val;
      }
    else
      {
        carp("No method defined for $config_vars{$var}->{value_type} vars yet");
      }
  }

sub open_database
  {
    my($part) = @_;

    my $dbfile = $config{"${part}_db_name"};
    my $dbtype = $config{db_type};

    croak("Cannot find db_name for \"${part}\"")
                              if(!defined $dbfile);

    $databases{$part} = {} if(!defined $databases{$part});
    $databases{$part}->{handle} = DBI->connect(
                          "dbi:$dbtype:$dir/$dbfile", "", "",
                              {RaiseError => 1, AutoCommit => 1});
  }

sub create_database
  {
    # We have to create a database with the appropriate tables in
    my($part) = @_;

    open_database($part);

    foreach my $table (MusicRoom::LogicalModel::list_physical_tables($part))
      {
        my $stmt = "CREATE TABLE \"$table\" ( ";

        my $id;
        foreach my $col (MusicRoom::LogicalModel::get_physical_columns($part,$table))
          {
            $id = "id" if($col eq "id");
            $id = "name" if(!defined $id && $col eq "name");

            my $spec = MusicRoom::LogicalModel::get_physical_column($part,$table,$col);

            $stmt .= "\"$col\" $spec, ";
          }
        croak("Must have an id or name in every table")
                                             if(!defined $id);

        # $stmt =~ s/, $/) /;
        $stmt .= "PRIMARY KEY ( \"$id\" ));";
        my $table = $databases{$part}->{handle}->prepare($stmt);
        if(!defined $table)
          {
            carp("Failed to prepare $stmt");
            next;
          }
        $table->execute();
      }
    # The loading up of data is done in the setup.pl script, if it was 
    # here then the complete initial list of valid items would be loaded
    # into every script that used MusicRoom and that would just be silly

    # But we do need to close the database so that the read_conf can open
    # it again
    shutdown_database($part);
  }

sub select
  {
    # Do an SQL statement 
    my($part,$table,$cols,$where_clause) = @_;

    if(!defined $databases{$part} || 
           !defined $databases{$part}->{handle})
      {
        carp("Must open database \"$part\" before attempting to use it");
        return undef;
      }
    if(ref($cols) ne "ARRAY")
      {
        carp("Must supply an array of column names");
        return undef;
      }
    if($#{$cols} < 0)
      {
        carp("Must supply at least one column to select");
        return undef;
      }

    my $stmt = "SELECT ".join(',',@{$cols})." FROM $table";
    if(defined $where_clause && $where_clause ne "")
      {
        $stmt .= " WHERE ".$where_clause;
      }
    $stmt .= ";";

    my $sth = $databases{$part}->{handle}->prepare($stmt);
    if(!defined $sth)
      {
        carp("Failed to prepare \"$stmt\"");
        return ();
      }
    my @result;
    my $rows_affected = $sth->execute();

    while(1)
      {
        my $ret = $sth->fetchrow_arrayref();
        return @result if(!defined $ret || ref($ret) ne "ARRAY" || !@{$ret});

        # Need to copy the result, otherwise the next fetchrow_arrayref() will
        # overwrite it
        my @result_arry = @{$ret};
        push @result,\@result_arry;
      }
  }

sub insert
  {
    my($part,$table,$cols,$values) = @_;

    if(!defined $databases{$part} || 
           !defined $databases{$part}->{handle})
      {
        carp("Must open database \"$part\" before attempting to use it");
        return undef;
      }
    if(ref($cols) ne "ARRAY")
      {
        carp("Must supply an array of column names");
        return undef;
      }
    if(ref($values) ne "ARRAY")
      {
        carp("Must supply an array of values");
        return undef;
      }
    if($#{$cols} < 0)
      {
        carp("Must supply at least one column to insert");
        return undef;
      }
    if($#{$cols} != $#{$values})
      {
        carp("Supplied ".($#{$values}+1)." values for ".($#{$cols}+1)." slots");
        return undef;
      }

    my @vals;
    foreach my $val (@{$values})
      {
        push @vals,quoteSQL($part,$val);
      }
    my $stat = "INSERT INTO $table (".join(',',@{$cols}).
                                           ") VALUES (".join(',',@vals).");";

    my $count = $databases{$part}->{handle}->do($stat);
    if($count != 1)
      {
        carp("Got return value of \"$count\" from \"$stat\"");
        return undef;
      }
    return 1;
  }

sub doSQL
  {
    # Do an SQL statement 
    my($part,$stmt) = @_;

    if(!defined $databases{$part} || 
           !defined $databases{$part}->{handle})
      {
        carp("Must open database \"$part\" before attempting to use it");
        return undef;
      }
    return $databases{$part}->{handle}->do($stmt);
  }

sub quoteSQL
  {
    # Convert a string to a form that SQL can manage
    my($part,$string) = @_;

    if(!defined $databases{$part} || 
           !defined $databases{$part}->{handle})
      {
        carp("Must open database \"$part\" before attempting to use it");
        return undef;
      }
    # Special cases
    return "\'".$string."\'"
                   if(lc($string) eq "true" || lc($string) eq "false");


    return $databases{$part}->{handle}->quote($string);
  }

sub shutdown_database
  {
    # Close down database handles
    my($part) = @_;

    if(defined $part)
      {
        $databases{$part}->{handle}->disconnect()
                      if(defined $databases{$part}->{handle});
        $databases{$part}->{handle} = undef;
        return;
      }
    foreach my $each_part (keys %databases)
      {
        shutdown_database($each_part);
      }
  }

1; # End of MusicRoom