view release on metacpan or  search on metacpan

lib/LCC/Backend/DBI.pm  view on Meta::CPAN

# Save the source specification
# Make sure that the table exists
# Return the object

  $self->{'source'} = $source;
  $self->create;
  return $self;
} #_new

#------------------------------------------------------------------------

# The following methods change the object

#------------------------------------------------------------------------

#  IN: 1 instantiated object

sub create {

# Obtain the object
# Obtain the database handle and the table name
# Create of the table, wrapped in eval to catch errors

  my $self = shift;
  my ($dbh,$table) = $self->_dbh_table;
  eval {$dbh->do( "CREATE TABLE $table (id CHAR(255), value CHAR(255))" )};
} #create

#------------------------------------------------------------------------

#  IN: 1 instantiated object
#      2 (optional) flag, specifying whether to force partial update

sub partial {

# Obtain the object
# Obtain database handle and table name
# Perform the selection

  my $self = shift;
  my ($dbh,$table) = $self->_dbh_table;
  my $sth = $dbh->prepare( "SELECT id,value FROM $table" );
  $sth->execute;

# Create the reference to the hash to be filled
# While there are records to be fetched
#  Save the value in the hash, special keys start with null byte
# Check whether UNS required full action

  my $old = $self->{'old'} = {};
  while (my ($key,$list) = $sth->fetchrow_array) {
    $key =~ s#^\0## ? $self->{$key} = $list : $old->{$key} = $list;
  }
  $self->_check_uns_complete unless shift || '';
} #partial

#------------------------------------------------------------------------

#  IN: 1 instantiated object

sub update {

# Obtain the object
# Add error if we haven't got anything to compare with
# Return now if there is nothing to do

  my $self = shift;
  $self->_add_error( "Unclear whether 'complete' or 'partial' update" )
   unless exists( $self->{'old'} );
  return unless exists $self->{'new'};

# Obtain the database handle and table name
# Create local copy of reference to old hash
# Initialize the statement handle for removing entries

  my ($dbh,$table) = $self->_dbh_table;
  my $old = $self->{'old'} || {};
  my $delete;

# If we are doing a partial update
#  Remove the special fields
#  Set the statement handle for removing
# Else (we're starting with a clean slate)
#  Make sure table is empty

  if (keys %{$old} ) {
    $dbh->do( "DELETE FROM $table WHERE id LIKE '\0%'" );
    $delete = $dbh->prepare( "DELETE FROM $table WHERE id=?" );
  } else {
    $dbh->do( "DELETE FROM $table" );
  }

# Create statement handle for updating
# For all of the special keys
#  Save the key, prefixed by a null byte to mark as special, and its value

  my $insert = $dbh->prepare( "INSERT INTO $table (id,value) VALUES (?,?)");
  foreach ($self->_additional_fields) {
    $insert->execute( "\0$_","$self->{$_}" ); # value in quotes needed!
  } # because the first value encountered determines quoting

# Create local copy of reference to new hash
# For all of the key => value pairs in the new hash
#  Remove the entry if we need to remove
#  Add the entry
#  Save/Overwrite the new value in the old hash, expand list if necessary
# Forget about any changes made

  my $new = $self->{'new'};
  while (my ($id,$value) = each( %{$new} )) {
    $delete->execute( $id ) if $delete;
    $insert->execute( $id,$value );
    $old->{$id} = $value;
  }
  delete( $self->{'new'} );
} #update

#------------------------------------------------------------------------

# The following subroutines deal with standard Perl features