view release on metacpan or  search on metacpan

lib/File/Properties/Database.pm  view on Meta::CPAN

sub sql {
  my $self = shift;
  my $sqlc = shift; # SQL command text

  return $self->dbi->do($sqlc);
}


# ----------------------------------------------------------------------------
# Define (and initialise) table
# ----------------------------------------------------------------------------
sub definetable {
  my $self = shift;
  my $tbnm = shift; # Table name
  my $cols = shift; # Column specification

  ## Create table if it doesn't exist. WARNING: when the table already
  ## exists, there is currently not a test to ensure that the existing
  ## layout matches the column specification in the arguments to this
  ## method
  my $sqlc = "CREATE TABLE IF NOT EXISTS $tbnm (" . join(',',@$cols) . ');';
  my $drtv = $self->sql($sqlc);
  # Record column names for this table
  $self->definedcolumns($tbnm, [map { /^[^\s]+/; $& } @$cols]);
  return $drtv;
}


# ----------------------------------------------------------------------------
# Insert rows into table
# ----------------------------------------------------------------------------
sub insert {
  my $self = shift;
  my $tbnm = shift; # Table name
  my $opts = shift; # Insert options

  # Determine column names for insert
  my $clnm = $self->_optioncols($tbnm, $opts);
  # Determine data for insert
  my $data = _optiondata($tbnm, $clnm, $opts);
  # Start transaction (autocommit off)
  $self->dbi->begin_work or
    throw File::Properties::Error("DBI error ".$self->dbi->errstr);
  # Construct string describing columns corresponding to row data,
  # using either specified array of column names, or recorded column
  # names for this table
  my $clst = join(',',@$clnm);
  # Construct insert statement
  my $sqlc = "INSERT INTO $tbnm ($clst) VALUES (" .
    join(',', map { '?' } @$clnm) . ');';
  # Prepare for insertion
  my $sth = $self->dbi->prepare($sqlc);
  # Execute insertion
  return $self->_executedata($sth, $data);
}


# ----------------------------------------------------------------------------
# Update rows in table
# ----------------------------------------------------------------------------
sub update {
  my $self = shift;
  my $tbnm = shift; # Table name
  my $opts = shift; # Update options

  # Determine column names for update
  my $clnm = $self->_optioncols($tbnm, $opts);
  # Determine data for update
  my $data = _optiondata($tbnm, $clnm, $opts);
  # Start transaction (autocommit off)
  $self->dbi->begin_work or
    throw File::Properties::Error("DBI error ".$self->dbi->errstr);
  # Construct update statement
  my $sqlc = "UPDATE $tbnm SET " . join(',', map { "$_=?" } @$clnm);
  $sqlc .= _optionwhere($opts);
  # Prepare for update
  my $sth = $self->dbi->prepare($sqlc);
  # Execute update
  return $self->_executedata($sth, $data);
}


# ----------------------------------------------------------------------------
# Select data from table
# ----------------------------------------------------------------------------
sub retrieve {
  my $self = shift;
  my $tbnm = shift; # Table name
  my $opts = shift; # Select options

  my $slc = 'SELECT ';
  # Select statement includes DISTINCT if 'Distint' option true
  $slc .= 'DISTINCT ' if (ref($opts) eq 'HASH' and $opts->{'Distinct'});
  my ($ncl, $cln);
  ## List of returned columns is constructed from the array provided
  ## with the 'Columns' option, otherwise all columns are returned
  if (ref($opts) eq 'HASH' and ref($opts->{'Columns'}) eq 'ARRAY') {
    $slc .= join(',',@{$opts->{'Columns'}}) . ' ';
    $cln = $opts->{'Columns'};
    $ncl = scalar @$cln;
  } else {
    $slc .= '* ';
    $cln = $self->definedcolumns($tbnm);
    $ncl = scalar @$cln;
  }
  # Append FROM and WHERE clauses to select statement
  $slc .= "FROM $tbnm " . _optionwhere($opts);
  # Append optional additional clauses to select statement
  $slc .= $opts->{'Suffix'} if (ref($opts) eq 'HASH' and $opts->{'Suffix'});
  # Check option 'ReturnType' for invalid values
  throw File::Properties::Error("Option 'ReturnType' may only have".
				"values 'Array' or 'Hash'")
    if (ref($opts) eq 'HASH' and defined($opts->{'ReturnType'}) and
        not($opts->{'ReturnType'} eq 'Array' or
	    $opts->{'ReturnType'} eq 'Hash'));
  ## DBI method for retrieving data depends on options 'ReturnType'
  ## and 'FirstRow'. If 'ReturnType' is not specified, data is
  ## retrieved as an array. If 'FirstRow' option is unspecified, or is
  ## false, a single row is returned.
  my $dat = undef;
  if (ref($opts) eq 'HASH' and defined($opts->{'ReturnType'}) and