# -*-perl-*-

# $Id: MultiData.plm,v 1.7 2011/08/08 15:21:10 timc Exp $

# $Log: MultiData.plm,v $
# Revision 1.7  2011/08/08 15:21:10  timc
# fix phrasebook uninit env var complaining
#
# Revision 1.6  2008/08/18 18:34:34  timc
# made change to phrasebook to add a NOWAIT and error message for when a what
# edithost is already in progress -- don't wait forever, just error out
#
# Revision 1.5  2006/04/11 14:35:06  thomas
# postgres is smart enough to grab the default krb5 principal in connect
#
# Revision 1.4  2006/01/25 17:41:31  thomas
# die instead of continuing on db failures [CSL #291251]
#
# Revision 1.3  2006/01/25 14:44:02  thomas
# Csdb.plm - Don't proceed when db not available [CSL #291251]
#
# Revision 1.2  2005/09/14 20:09:15  thomas
# doc updates
#
# Revision 1.1  2005/01/14 16:31:47  thomas
# New entries
#
# Revision 1.3  2004/07/02 19:03:04  thomas
# documentation update
#
# Revision 1.2  2004/06/08 16:11:24  thomas
# Move attribute list culling and fixing to HostAttributes
#
# Revision 1.1  2004/06/08 14:22:28  thomas
# Provide access to host attribute lists
#

=head1 NAME

B<MultiData.pm> - Provide persistent postgres storage for multiple
data types

=head1 SYNOPSIS

  use What::MultiData;

  my $md = new What::MultiData (%opts);

  my @$keys = $md->find ();
  my $data = $md->find ($key);

  my $data = $md->lock ($key);
  my $ret = $md->unlock ();
  my $ret = $md->set ($key, $data);
  my $ret = $md->drop ($key);

  my @attr_names = $md->find_index ();
  my @attr_values = $md->find_index ($attr_name);
  my @keys = $md->find_index ($attr_name, $attr_value);

  my $ret = $md->close(%opts);


=head1 DESCRIPTION

This module updates, queries, loads and saves data for multiple data
types in a single set of sql database tables.

=head1 METHODS

=over 4

=cut

package What::MultiData;

use strict;
use Text::ParseWords;
use CSL::DBs;
use CSL::Pg;
use DBI;
use Class::Phrasebook::SQL;
use Log::LogLite;
use Data::Dumper;

###############################################################################
# Create a new data object.

=item my $attrs = new  (%opts);

The new function creates a B<What::MultiData> object, and opens a
connection to the corresponding database.

The %opts may consist of:

=over 4

=item logfile

A file name to handle all diagnostic output.  If not specified, all
diagnostic output will go to the file /tmp/what.log.ha.I<user>.

=item debug

See the Log::LogLite man page for a description of logging levels.

=item db

The database to connect to.  The default is the $CSL::DBs::csdb
database.  The connection will always be the multi_data table in the
what schema in the selected db.

=back

=cut

sub new {
  my $invocant = shift;
  my $opts = {@_};

  my $class = ref ($invocant) || $invocant;
  my ($db, $key);

  # Copy the given opts
  my $self = bless { opts => {%$opts}, } => $class;

  # Figure out the user
  if ($< > 0) {
    $self->{luser} = getpwuid($<);
    if (!defined ($self->{luser})) {
      print STDERR "Lookup failed for user $<!\n";
      return undef;
    }
  } else {
    $self->{luser} = undef;
  }

  # Do some logging
  defined ($self->{opts}->{logfile}) or
    $self->{opts}->{logfile} = "/tmp/what.log.md.$self->{luser}";
  defined ($self->{opts}->{debug}) or $self->{opts}->{debug} = 5;
  $self->{opts}->{debug} = 1;
  if (!defined ($self->{loglite} = new Log::LogLite
		($self->{opts}->{logfile}, $self->{opts}->{debug}))) {
    print STDERR "Failed to initialize HostAttribute log file $self->{opts}->{logfile}!\n";
    return undef;
  }

  $self->{db} = $CSL::DBs::csdb;
  if (ref($invocant) && defined ($invocant->{db})) {
    $self->{db} = $invocant->{db}
  }
  defined ($opts->{db}) and $self->{db} = $opts->{db};

  $self->{dbh} = DBI->connect (
			       $self->{db},
			       $self->{luser},
			       "",
			      );

  if (!defined $self->{dbh}) {
    # Don't go any further than this [CSL #291251]
    die "Failed to open database.  This is a Bad Thing(tm).\n";
  }


  #https://rt.cs.wisc.edu/rt/Ticket/Display.html?id=457884
  #Phrasebook now wants this set or it complains
  $ENV{'PHRASEBOOK_SQL_DEBUG_PRINTS'} = "";


  # Also load up the phrasebook
  if (!defined ($self->{pb} = new Class::Phrasebook::SQL
		(
		 $self->{loglite},
		 "/s/what-0.1.31/etc/MultiData.phrasebook.xml",
		))) {
    die "Failed to create phrasebook!";
  }
  if (!$self->{pb}->load ("Pg")) {
    die "Failed to read Pg phrasebook!";
  }

  # Go to the correct schema
  my $phrase = $self->{pb}->get ("set_search_path");
  $self->{dbh}->begin_work;
  my $ret = $self->{dbh}->do ($phrase);
  $self->{dbh}->commit;

  # All OK
  return $self;
}

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

=item my @$hosts = $attrs->find ();

=item my $text = $attrs->find ($host);

Called without any arguments, it returns a list of all the keys in the
current table.

With a single argument, it returns the data corresponding to the
passed key.

=cut

sub find {
  my $self = shift;

  my $module = ref ($self) || $self;

  $self->{dbh}->begin_work;
  my $ret = $self->getdata (@_);
  $self->{dbh}->commit;
  return $ret;
}


# Do a find in someone else's transaction
sub getdata {
  my $self = shift;

  my $module = ref ($self) || $self;
  my ($key, $phrase, $ret, $data, $text);

  if (scalar @_) {
    $key = shift;
    # Return data for a single host
    $phrase = $self->{pb}->get ("get_data",
				{
				 module => $self->{dbh}->quote($module),
				 key    => $self->{dbh}->quote($key)
				}
			       );
    $ret = $self->{dbh}->selectcol_arrayref ($phrase);
    defined ($ret) or return undef;
    $text = $ret->[0];
    defined ($text) or return undef;
    eval $text;
    return ($data);
  } else {
    # Return a list of keys in the db
    $phrase = $self->{pb}->get ("get_keys",
				{
				 module => $self->{dbh}->quote($module)
				}
			       );
    $ret = $self->{dbh}->selectcol_arrayref ($phrase);
    return $ret;
  }
}

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

=item $data = $md->lock ($key);

Returns the data associated with $key (usually a host name), and locks
the data in the database to prevent anyone else from modifying it.

This call B<must> be followed by either unlock, set, or drop.

=cut

sub lock {
  my $self = shift;
  my $key = shift;

  my ($phrase, $ret, $text, $data);

  my $module = ref ($self) || $self;

  defined ($key) or return (undef);

  # Return data for a single key
  $phrase = $self->{pb}->get ("lock_data",
			      {
			       module => $self->{dbh}->quote($module),
			       key => $self->{dbh}->quote($key)
			      }
			     );
  $self->{dbh}->begin_work;
  $ret = $self->{dbh}->selectcol_arrayref ($phrase);
  # Don't commit -- leave row locked
  # No rows found is not a db error and will return undef
  # The eval will put the data in $data.

  # check to see if there's an error, if so, say why and bail
  # timc
  if (!defined ($ret)) {
    die "\n\tCan not obtain database lock -- someone else is editing the file?\n\n";
  }

  defined ($ret) or return undef;
  $text = $ret->[0];
  defined ($text) or return undef;
  eval $text;


  return ($data);
}


=item $text = $attrs->unlock ();

Roll back the db transaction began with an lock() call.

=cut


sub unlock {
  my $self = shift;

  $self->{dbh}->rollback;
  return 1;
}


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

=item $ret = $dep->set ($key, $data);

Update the data associated with $key (usually a host name) with $data
(an arbitrary perl data structure).

The $key B<must> be previously lock()ed before calling set()

If $data is undefined, drop any existing data.

Returns 1 for success, 0 for failure.

=cut

sub set {
  my $self = shift;
  my $key = shift;
  my $data = shift;

  my ($phrase, $ret, $index, $id);

  my $module = ref ($self) || $self;

  if (!defined ($key) || !length ($key)) {
    $self->{loglite}->write ("Skipping update with empty key\n", 5);
    return 0;
  }

  my $olddata = $self->getdata ($key);
  if (!defined ($olddata) && !defined ($data)) {
    print STDERR "Set: Requested drop of non-key $key.  Skipping delete.\n";
    $self->{dbh}->rollback;
    return 0;

  }

  defined ($data) or return $self->drop ($key);

  if (defined ($olddata) && ($data eq $olddata)) {
    print STDERR "No data changed for $key.  Skipping update.\n";
    $self->{dbh}->rollback;
    return 0;
  }

  # Remove anything that may have been there
  $self->drop_nocommit ($key);

  # Install new data
  my $text = Data::Dumper->Dump([$data], ['data']);
  $phrase = $self->{pb}->get ("add_data",
			      {
			       module => $self->{dbh}->quote($module),
			       key => $self->{dbh}->quote($key),
			       data => $self->{dbh}->quote($text),
			      });
  $ret = $self->{dbh}->do ($phrase);

  $id=0;
  foreach $index ($self->getindex ($key, $data)) {
    foreach (keys %$index) {
      $phrase = $self->{pb}->get ("add_data_index",
				  {
				   module => $self->{dbh}->quote($module),
				   key => $self->{dbh}->quote($key),
				   index => $id,
				   attribute => $self->{dbh}->quote($_),
				   value => $self->{dbh}->quote($index->{$_}),
				  });
      $ret =  $self->{dbh}->do ($phrase);
    }
    $id++;
  }

  $self->{dbh}->commit;
  return $ret;
}


# Provide a default getindex.  If a data module wants alternate indexes,
# they have to provide a replacement.  Return an array of hashes.

sub getindex {
  return  (());
}


# Drop some data.  This _must_ have been preceeded by a lock().
sub drop {
  my $self = shift;
  my $key = shift;

  my ($ret);

  $ret = $self->drop_nocommit ($key);
  $self->{dbh}->commit;
  return $ret;
}

sub drop_nocommit {
  my $self = shift;
  my $key = shift;

  my ($phrase, $ret);

  my $module = ref ($self) || $self;

  if (!defined ($key) || !length ($key)) {
    $self->{loglite}->write ("Skipping drop with empty key\n", 5);
    return 0;
  }

  # Remove data
  # Don't begin -- this _must_ be preceeded by a lock()
  $phrase = $self->{pb}->get ("drop_data_index",
			      {
			       module => $self->{dbh}->quote($module),
			       key => $self->{dbh}->quote($key)
			      }
			     );
  $ret = $self->{dbh}->do ($phrase);

  $phrase = $self->{pb}->get ("drop_data",
			      {
			       module => $self->{dbh}->quote($module),
			       key => $self->{dbh}->quote($key)
			      }
			     );
  $ret = $self->{dbh}->do ($phrase);

  return $ret;
}


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

=item my @attr_names = $md->find_index ();

Passed without any arguments, return the list of all attribute names
for this module.

=item my @attr_values = $md->find_index ($attr_name);

Passed with a single argument, return the set of all values seen for the given attibute.

=item my @keys = $md->find_index ($attr_name, $attr_value);

Passed with an attribute name and value, return a list of all keys containing the specified pair.

=cut

sub find_index {
  my $self = shift;

  my ($attr_name, $attr_value) = ('','');
  my ($phrase, $ret, $query);

  my $module = ref ($self) || $self;

  if (@_) {
    $attr_name = shift;
    if (@_) {
      $attr_value = shift;
      # Return all the keys with the (name, value) pair
      $query = 'get_index_keys';
    } else {
      # Return all the values found for the given attr.
      $query = 'get_index_values';
    }
  } else {
    # Return all attribute names
    $query = 'get_index_names';
  }
  $phrase = $self->{pb}->get ($query,
			      {
			       module => $self->{dbh}->quote($module),
			       attribute => $self->{dbh}->quote($attr_name),
			       value => $self->{dbh}->quote($attr_value),
			      }
			     );
  $ret = $self->{dbh}->begin_work;
  $ret = $self->{dbh}->selectcol_arrayref ($phrase);
  $self->{dbh}->commit;
  return @$ret;
}

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

=item $ret = $attrs->close(%opts);

Close the database connection and free resources.

=cut

sub close {
  my $self = shift;

  delete $self->{pb};
  delete $self->{loglite};
  $self->{dbh}->disconnect;
  delete $self->{dbh};
  undef $self;
  return undef;
}


###############################################################################
# Misc routine -- Quote out '"' and '&' characters in xml strings

sub xmlquote {
  my $self = shift;
  my $string = shift;

  $string =~ s/\&/\&amp;/g;
  $string =~ s/\"/\&quot;/g;
  $string =~ s/\</&lt;/g;
  $string =~ s/\>/&gt;/g;
  "\"$string\"";
}


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

1;

# End the documentation

=back

=head1 SEE ALSO

What::Command::edithost
