MusicRoom::Zone - Manage different stores that hold music

package MusicRoom::Zone;

use strict;
use warnings;
use Carp;

use MusicRoom;
use MusicRoom::STN;

# Define some sizes and other things the database needs
use constant ID_LENGTH => 6;
use constant NAME_LENGTH => 30;
use constant PATH_LENGTH => 254;

use constant RESIDENT_PART => "core";
use constant TABLE_NAME => "zone";
use constant USER_CLASS => "Zone";
use constant PERL_CLASS => "MusicRoom::" . USER_CLASS;

my @attributes =
  (
    id => 
      {
        type => "text",
        length => ID_LENGTH,
        fixed => 1,
      },
    name => 
      {
        type => "text",
        length => NAME_LENGTH,
        required => 1,
      },
    volume_spec => 
      {
        type => "text",
        length => NAME_LENGTH,
      },
    root_dir => 
      {
        type => "text",
        length => PATH_LENGTH,
      },
    dir_spec => 
      {
        type => "text",
        length => PATH_LENGTH,
        default_value => "<dir_artist> - <dir_album>",
      },
    file_spec => 
      {
        type => "text",
        length => PATH_LENGTH,
        default_value => "<track:02> - <artist> - <song>",
      },
    reformat => 
      {
        type => "boolean",
        default_value => "",
      },
    format =>
      {
        type => "enum",
        options => [MusicRoom::File::formats()],
        default_value => "mp3:128",
      },
    role => 
      {
        type => "enum",
        options => ["scratch","import","best", "active", "gather"],
        required => 1,
        fixed => 1,
      },
  );

######################################################################
# From here downwards is the same for all the object classes
# (I am sure there is a better way to share this code but I can't 
#   think what it is at the moment, so I do the simple thing)
#
my(%attributes,@db_fields,@db_specs,%data);

sub table_name
  {
    reorganise_description();
    return TABLE_NAME;
  }

sub id_spec
  {
    reorganise_description();
    return TABLE_NAME.".id";
  }

sub ref_spec
  {
    my($attrib) = @_;

    reorganise_description();
    $attrib = "id" if(!defined $attrib);

    for(my $i=0;$i<=$#attributes;$i+=2)
      {
        return %{$attributes[$i+1]}
                  if($attributes[$i] eq $attrib);
      }
    carp("Cannot find attribute $attrib");
    return undef;
  }

sub table_spec
  {
    reorganise_description();
    return
      (
        # I would like to say:
        #     TABLE_NAME => [id => "text:".(ID_LENGTH+2)...
        # but the fat comma causes the constant not to be expanded
        TABLE_NAME,\@db_specs
      );
  }

sub attribs
  {
    reorganise_description();
    my @attribs;
    for(my $i=0;$i<=$#attributes;$i+=2)
      {
        push @attribs,$attributes[$i];
      }
    return @attribs;
  }

sub reorganise_description
  {
    my @ret;

    return if(@db_fields);
    for(my $attrib_num=0;$attrib_num<=$#attributes;$attrib_num+=2)
      {
        my $attrib_name = $attributes[$attrib_num];
        my $attrib_spec = $attributes[$attrib_num+1];

        if(defined $attributes{$attrib_name})
          {
            craok("Duplicate attribute $attrib_name");
          }

        $attributes{$attrib_name} = $attrib_spec;
        my $db_name = $attrib_name;
        $db_name = $attrib_spec->{db_name} 
                               if(defined $attrib_spec->{db_name});
        my $db_spec;
        if(!defined $attrib_spec->{type})
          {
            carp("Must define type for $attrib_name");
          }
        elsif($attrib_spec->{type} eq "text")
          {
            carp("Must specify length on text field $attrib_name")
                              if(!defined $attrib_spec->{length});
            $db_spec = "text:".($attrib_spec->{length} + 2);
          }
        elsif($attrib_spec->{type} eq "boolean")
          {
            $db_spec = "boolean";
          }
        elsif($attrib_spec->{type} eq "enum")
          {
            carp("Must specify valid values for enum $attrib_name")
                              if(!defined $attrib_spec->{options});
            $db_spec = $attrib_spec->{options};
          }
        elsif($attrib_spec->{type} eq "integer")
          {
            $db_spec = "integer";
          }
        else
          {
            carp("Cannot yet translate $attrib_spec->{type} into DB spec");
          }
        push @db_specs,$db_name,$db_spec;
        push @db_fields,$db_name;
      }
  }

sub get
  {
    my $this = shift;
    croak("$this is not an ".USER_CLASS) if(ref($this) ne PERL_CLASS);
    croak("$this is not an ".USER_CLASS) if(length(${$this}) != ID_LENGTH);
    my(@attribs) = @_;

    reorganise_description();

    if($#attribs < 0)
      {
        carp("Must pass at least one attribute to get()");
        return undef;
      }

    foreach my $attrib (@attribs)
      {
        if(!defined $attributes{$attrib})
          {
            carp("No such attribute ($attrib)");
            return undef;
          }
      }

    my @result = MusicRoom::select(RESIDENT_PART,
                                 TABLE_NAME,\@attribs,
                                 "id=".MusicRoom::quoteSQL(RESIDENT_PART,$$this));
    if($#result != 0)
      {
        # Should only have a single row returned
        carp("Attempt to extract single row from ".TABLE_NAME.
                   "(with id=$$this) returned ".($#result+1)." rows");
        return undef;
      }
    # If we have a set of attributes we are after leave them packed into 
    # the array, if we want just one attribute then unpick it from 
    # the container
    return @{$result[0]} if($#attribs > 0);
    return $result[0]->[0];
  }

sub set
  {
    my $this = shift;
    croak("$this is not an ".USER_CLASS) if(ref($this) ne PERL_CLASS);
    croak("$this is not an ".USER_CLASS) if(length(${$this}) != ID_LENGTH);
    my(%values) = @_;

    reorganise_description();

    my $stmt = "UPDATE ".TABLE_NAME." SET ";
    my $first_loop = 1;

    foreach my $attrib (keys %values)
      {
        if(!defined $attributes{$attrib})
          {
            carp("No such attribute ($attrib)");
            next;
          }

        my $val = $values{$attrib};

        if(defined $attributes{$attrib}->{fixed})
          {
            carp("Cannot modify attribute $attrib");
            next;
          }

        if($attributes{$attrib}->{type} eq "enum")
          {
            # Check that the value is valid
          }
        elsif($attributes{$attrib}->{type} eq "boolean")
          {
            # Check that the value is valid
          }

        $stmt .= ", " if(!$first_loop);
        $first_loop = "";
        $stmt .= "$attrib = ".
                      MusicRoom::quoteSQL(RESIDENT_PART,$val);
      }

    return if($first_loop);
    MusicRoom::doSQL(RESIDENT_PART,$stmt);
  }

sub AUTOLOAD
  {
    # Almost straight from the camel
    my $this = shift;
    croak("$this is not an ".USER_CLASS) if(ref($this) ne PERL_CLASS);
    croak("$this is not an ".USER_CLASS) if(length(${$this}) != ID_LENGTH);

    reorganise_description();

    my $name;

      {
        no strict;
        $name = $AUTOLOAD;
      }

    $name =~ s/.*://;

    if(!exists $attributes{$name})
      {
        carp("Attribute $name is not defined");
        return undef;
      }

    if(@_)
      {
        # We want to set an attribute, we have to write it 
        # through to the database
        my $val = shift @_;
        
        return $val if($val eq $this->{$name});
        return $this->set($name => $val);
      }
    return $this->get($name);
  }

sub new
  {
    my $class = shift;

    reorganise_description();

    my %this;
    # The required attributes must come first (in the correct order)
    # then we have optional params defined as pairs
    for(my $i=0;$i<=$#{attributes};$i+=2)
      {
        if($attributes[$i+1]->{required})
          {
            $this{$attributes[$i]} = shift;
          }
      }

    # Now lets see which ones we have set by the caller as options
    for(my $i=0;$i<=$#_;$i+=2)
      {
        if(defined $attributes{$_[$i]})
          {
            $this{$_[$i]} = $_[$i+1];
          }
        else
          {
            carp("Unknown attribute $_[$i]");
          }
      }

    if(defined $this{id})
      {
        # Check that this ID is unique
        my @result = MusicRoom::select(RESIDENT_PART,
                                 TABLE_NAME,['id'],
                                 "id=".MusicRoom::quoteSQL(RESIDENT_PART,$this{id}));
        if($#result >= 0)
          {
            carp("ID $this{id} is not unique");
            delete $this{id};
          }
      }

    while(!defined $this{id})
      {
        # Set the ID
        $this{id} = MusicRoom::STN::unique(undef,ID_LENGTH);
        my @result = MusicRoom::select(RESIDENT_PART,
                                 TABLE_NAME,['id'],
                                 "id=".MusicRoom::quoteSQL(RESIDENT_PART,$this{id}));
        if($#result >= 0)
          {
            delete $this{id};
          }
      }

    # Now do we have any default values we want to add in?
    for(my $i=0;$i<=$#{attributes};$i+=2)
      {
        next if(defined $this{$attributes[$i]});
        if(defined $attributes[$i+1]->{default_value})
          {
            $this{$attributes[$i]} = 
                        $attributes[$i+1]->{default_value};
          }
      }

    my @values;

    # There is a bug here, if anyone ever has a different 
    # db_column name from the attribute name this will need
    # fixing
    foreach my $attrib (@db_fields)
      {
        $this{$attrib} = "" if(!defined $this{$attrib});
        push @values,$this{$attrib};
      }

    my $success = MusicRoom::insert(RESIDENT_PART,TABLE_NAME,
                                    \@db_fields,\@values);
    if(!defined $success || $success eq "-1")
      {
        carp("Failed to INSERT into ".TABLE_NAME);
        return undef;
      }
    my $id = $this{id};
    return bless \$id,$class;
  }

sub DESTROY
  {
  }

sub select
  {
    # If we are called inirectly then just throw away the class name
    shift @_
        if($#_ >= 0 && $_[0] eq PERL_CLASS);

    my(@where) = @_;

    # Return a list of objects that match a where clause
    my $where;
    if($#where < 0)
      {
        $where = undef;
      }
    elsif($#where == 0)
      {
        $where = $where[0];
      }
    else
      {
        for(my $i=0;$i<=$#where;$i+=2)
          {
            $where .= " AND" if($i != 0);
            $where .= $where[$i]." = ".
                      MusicRoom::quoteSQL(RESIDENT_PART,$where[$i+1]);
          }
      }
    my @ids = MusicRoom::select(RESIDENT_PART,
                                 TABLE_NAME,['id'],$where);
    # Convert the returned ID list into objects
    my @results;
    foreach my $id (@ids)
      {
        # This is just one of those constructs you have to 
        # look up if you don't understand
        push @results,bless \$id->[0],PERL_CLASS;
      }
    return @results;
  }

1;