root/trunk/antimatter/tim/Modules/SFLC/TimeTracker/DB.pm

# DB.pm                                                          -*- Perl -*-
#  Database module for SFLC time tracker
# Copyright (C) 2005, 2006, 2007   Software Freedom Law Center, Inc.
#  Author: Bradley M. Kuhn <bkuhn@softwarefreedom.org>
#
#  This software gives you freedom; it is licensed to you under version
#  3 of the GNU Affero General Public License, along with the
#  additional permission in the following paragraph.
#
#  This software is distributed WITHOUT ANY WARRANTY, without even the
#  implied warranties of MERCHANTABILITY and FITNESS FOR A PARTICULAR
#  PURPOSE.  See the GNU Affero General Public License for further
#  details.
#
# You should have received a copy of the GNU Affero General Public
# License, version 3 along with this software.  If not, see
# <http://www.gnu.org/licenses/>.


sub UnLock {}
sub Lock {}
sub ReadLock {}

package SFLC::TimeTracker::DB;

use strict;
use warnings;


require Exporter;
#use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

our @EXPORT_OK = ();

our @EXPORT = qw( );

our $VERSION = '0.01';

# FIXME: STOP HARD CODING THE USER LIST EVERYWHERE
my @VALID_USERS = qw/user1 user2 user3/;

use Carp;

use Date::Manip;
use Storable;
use MLDBM::Sync;
use MLDBM qw(DB_File Storable);
use Fcntl qw(:DEFAULT);
###############################################################################

=head1 NAME

SFLC::TimeTrack::DB - Database instance for SFLC TimeTracker application

=head1 SYNOPSIS

  use SFLC::TimeTrack::DB;

  my $database = new SFLC::TimeTrack::DB($TYPE, $OPTION1, $OPTION2)

=head1 DESCRIPTION

Creates a database object for storing time tracker data at SFLC.

Currently, only the MLDBM type is supported.  Effectively, I've written
SFLC::TimeTrack::DB::MLDBM.  This should really be a wrapper class that
has an MLDBM underlying implementation and an SQL one.

=head2 EXPORT

None.

=head1 SEE ALSO

SFLC::TimeTrack::Input

=head1 AUTHOR

Bradley M. Kuhn, E<lt>bkuhn@softwarefreedom.org<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2005, 2006, 2007   Software Freedom Law Center, Inc.

This software gives you freedom; it is licensed to you under version
3 of the GNU Affero General Public License.

This software is distributed WITHOUT ANY WARRANTY, without even the
implied warranties of MERCHANTABILITY and FITNESS FOR A PARTICULAR
PURPOSE.  See the GNU Affero General Public License for further
details.

You should have received a copy of the GNU Affero General Public
License, version 3 along with this software.  If not, see
<http://www.gnu.org/licenses/>.

=head1 EXTERNAL FUNCTIONS

=over

=cut

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

=item new

usage: new($METHOD, $OPTION1, $OPTION1)

Instantiates a new database storage method for an SFLC::TimeTrack
database.

=head2 ARGUMENTS

=over

=item C<$method>

Storage method used.  Currently, the only valid C<$METHOD> is "MLDBM".  In
the future, I hope to implement a true database storage method.

=item C<$OPTION1>

For MLDBM, C<$option1> is the path to the file that will store the
completed time data.

=item C<$option2>

For MLDBM, C<$option2> is the path to the pending data (tasks started but
never closed).

=back

=cut

sub new {
  my($class, $method, $option1, $option2) = @_;

  croak "Invalid storage method $method" if ($method ne "MLDBM");

  my $self = {}; bless $self, $class;

  $self->{db}{main}{filename} = $option1;
  $self->{db}{pending}{filename} = $option2;
  foreach my $db (qw/main pending/) {
    $self->{dbm}{$db} = tie(%{$self->{$db}}, 'MLDBM::Sync',
                            $self->{db}{$db}{filename}, O_CREAT|O_RDWR, 0600)
      or croak "Cannot open database '$self->{db}{$db}{filename}: $!\n";

    $self->{db}{$db}{amReading} = $self->{db}{$db}{amWriting} = 0;

  }
  return $self;
}
###############################################################################

=item beginReadWork

usage: beginReadWork()

Begin read work on the datatbase.

=head2 ARGUMENTS

=over

=item C<$db>

String representing what database to begin work on.

=back

=cut

sub beginReadWork  {
  my($self, $db) = @_;

  croak "unknown database $db" unless defined $self->{db}{$db};

  if ($self->{db}{$db}{amReading} <= 0) {
    $self->{dbm}{$db}->ReadLock;
    $self->{db}{$db}{amReading} = 1;
  } else {
    $self->{db}{$db}{amReading}++;
  }
}


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

=item beginWriteWork

usage: beginWriteWork($db)

Begin read work on the datatbase.

=head2 ARGUMENTS

=over

=item C<$db>

String representing what database to begin work on.

=back

=cut

sub beginWriteWork  {
  my($self, $db) = @_;

  croak "unknown database $db" unless defined $self->{db}{$db};
  if ($self->{db}{$db}{amWriting} <= 0) {
    $self->{dbm}{$db}->Lock;
    $self->{db}{$db}{amWriting} = 1;
  } else {
    $self->{db}{$db}{amWriting}++;
  }
}

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

=item endWriteWork

usage: endWriteWork($db)

end read work on the datatbase.

=head2 ARGUMENTS

=over

=item C<$db>

String representing what database to end work on.

=back

=cut

sub endWriteWork  {
  my($self, $db) = @_;

  croak "unknown database $db" unless defined $self->{db}{$db};
  $self->{db}{$db}{amWriting}--;
  if ($self->{db}{$db}{amWriting} <= 0) {
    $self->{dbm}{$db}->UnLock;
    $self->{db}{$db}{amWriting} = 0;
  }
}


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

=item endReadWork

usage: endReadWork($db)

end read work on the datatbase.

=head2 ARGUMENTS

=over

=item C<$db>

String representing what database to end work on.

=back

=cut

sub endReadWork  {
  my($self, $db) = @_;

  croak "unknown database $db" unless defined $self->{db}{$db};
  $self->{db}{$db}{amReading}--;
  if ($self->{db}{$db}{amReading} <= 0) {
    $self->{dbm}{$db}->UnLock;
    $self->{db}{$db}{amReading} = 0;
  }
}

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

=item getCategoryHandle

usage: getCategoryHandle($categoryString)

Confirms that C<$categoryString> represents a real category name (croak'ing on an
error if it isn't) and returns the internal handle value for the category.

In the MLDBM world, this *is* the same as the cannonicalized
C<$categoryString>), but when futrue storage mechanisms exist, it won't be.

=head2 ARGUMENTS

=over

=item C<$db>

String representing what database to end work on.

=back

=cut

sub getCategoryHandle  {
  my($self, $categoryString) = @_;

  my $retVal;
  $self->beginReadWork("main");
  if (defined $self->{main}{categoryAliases}{GLOBAL}{$categoryString}) {
    $retVal =  $self->{main}{categoryAliases}{GLOBAL}{$categoryString};
  } elsif (defined $self->{main}{categoryList}{$categoryString}) {
    $retVal =  $categoryString;
  }
  $self->endReadWork("main");
  croak "lookup of undefined category, $categoryString" unless defined $retVal;
  return $retVal;
}

sub getCategoryName {
  my($self, $categoryHandle) = @_;

  $self->beginReadWork("main");

  if (not defined $self->{main}{categoryList}{$categoryHandle}) {
    $self->endReadWork("main");
    return undef;
  } else {
    my $retVal =  $self->{main}{categoryList}{$categoryHandle}->{name};
    $self->endReadWork("main");
    return $retVal;
  }
}

sub getCategoryHandleForUserHandle  {
  my($self, $categoryString, $userHandle) = @_;

  $self->beginReadWork("main");

  croak "invalid user handle $userHandle"
      unless defined $self->{main}{categoryAliases}{users}{$userHandle};

  my $retVal;
  if (defined $self->{main}{categoryList}{$categoryString}) {
    $retVal =  $categoryString;
  } elsif (defined $self->{main}{categoryAliases}{GLOBAL}{$categoryString}) {
    $retVal =  $self->{main}{categoryAliases}{GLOBAL}{$categoryString};
  } elsif (defined $self->{main}{categoryAliases}{users}
                              {$userHandle}{$categoryString}) {
    $retVal = $self->{main}{categoryAliases}{users}
                              {$userHandle}{$categoryString};
  }

  $self->endReadWork("main");
  carp "lookup of undefined category, $categoryString" unless defined $retVal;
  return $retVal;
}

sub getCategory {
  my($self, $catString) = @_;
  my $handle = $self->getCategoryHandle($catString);
  my $retVal;
  if (defined $handle) {
    $self->beginReadWork("main");
    $retVal = $self->{main}{categoryList}{$handle};
    $self->endReadWork("main");
  }
  return $retVal;
}


sub getCategoryAliasList {
  my($self, $userHandle) = @_;

  if (defined $userHandle) {
    $self->beginReadWork("main");
    croak "invalid user handle $userHandle"
      unless defined $self->{main}{categoryAliases}{users}{$userHandle};
    my @val;
    push(@val, keys %{$self->{main}{categoryAliases}{users}{$userHandle}});
    push(@val, keys %{$self->{main}{categoryAliases}{GLOBAL}});

    $self->endReadWork("main");
    return @val;
  } else {
    my @val;
    $self->beginReadWork("main");
    push(@val, keys %{$self->{main}{categoryAliases}{GLOBAL}});
    $self->endReadWork("main");
    return @val;
  }
}

=item getUserHandle

usage: getUserHandle($userString)

Confirms that C<$userString> represents a real user name (croak'ing on an
error if it isn't) and returns the internal handle value for the user.

In the MLDBM world, this *is* the same as the cannonicalized
C<$userString>), but when futrue storage mechanisms exist, it won't be.

=head2 ARGUMENTS

=over

=item C<$db>

String representing what database to end work on.

=back

=cut

sub getUserHandle  {
  my($self, $userString) = @_;

  $self->beginReadWork("main");
  my $isDefined = (defined $self->{main}{entries}{byUser}{$userString});
  $self->endReadWork("main");

  $isDefined ? return $userString : undef;
}

sub checkIgnoreLines {
  my($self, $userH, $line) = @_;

  $self->beginReadWork("main");
  unless (defined $self->{main}{ignoreLines}{users}{$userH}) {
    carp "invalid user handle $userH during ignore line check of $line";
    $self->endReadWork("main");
    return 0;
  }
  chomp $line;
  my $retVal = defined $self->{main}{ignoreLines}{users}{$userH}{"\L$line\E"};
  $self->endReadWork("main");
  return $retVal;

}
sub categoryAliasLookup {
  my($self, $userH, $alias) = @_;
  my %x;

  my $retVal;
  $alias = "\L$alias\E";
  $self->beginReadWork("main");

  if (defined $userH and
      defined $self->{main}{categoryAliases}{users}{$userH} and
      defined $self->{main}{categoryAliases}{users}{$userH}{$alias}) {
    $retVal = $self->{main}{categoryAliases}{users}{$userH}{$alias};
  } elsif (defined $self->{main}{categoryAliases}{GLOBAL}{$alias}) {
    $retVal = $self->{main}{categoryAliases}{GLOBAL}{$alias};
  }
  $self->endReadWork("main");

  (defined $retVal) ? print "looking up $alias, found $retVal\n" :
    print "category alias lookup failed on $alias\n";
  return $retVal;
}

sub setCategoryAlias {
  my($self, $userH, $alias, $category) = @_;
  my %x;

  $category = $self->getCategory($category) if (not ref $category);

  croak "cannot alias an undefined category" if (not defined $category);

  my $retVal;
  $alias = "\L$alias\E";
  $alias =~ s/\.//g;
  $alias =~ s%:%/%g;
  $alias = "/$alias" unless $alias =~ m%^/%;

  $self->beginWriteWork("main");
  my(%aliases) = %{$self->{main}{categoryAliases}};
  unless (defined $aliases{users}{$userH}) {
    carp "invalid user handle $userH during lookup of $alias";
    $self->endWriteWork("main");
    return undef;
  }
  $aliases{users}{$userH}{$alias} = $category->get('id');
  $self->{main}{categoryAliases} = \%aliases;
  $self->endWriteWork("main");
  print "just alised $alias, to $category->{id}\n";
  return $category->{id};
}

sub unsetCategoryAlias {
  my($self, $userH, $alias) = @_;
  my %x;

  my $retVal;
  $alias = "\L$alias\E";
  $self->beginWriteWork("main");
  my(%aliases) = %{$self->{main}{categoryAliases}};
  unless (defined $aliases{users}{$userH}) {
    $self->endWriteWork("main");
    return undef;
  }
  my $catId = $aliases{users}{$userH}{$alias};
  delete $aliases{users}{$userH}{$alias};
  $self->{main}{categoryAliases} = \%aliases;
  $self->endWriteWork("main");
  print "just unalised $alias for $userH\n";
  return $catId;
}

sub setGlobalCategoryAlias {
  my($self, $alias, $category) = @_;
  my %x;

  my $retVal;
  $alias = "\L$alias\E";
  $self->beginWriteWork("main");
  my(%aliases) = %{$self->{main}{categoryAliases}};

  $aliases{GLOBAL}{$alias} = $category->{id};
  $self->{main}{categoryAliases} = \%aliases;
  $self->endWriteWork("main");
  print "just set $alias, to $category\n";
  return $category->{id};
}

sub getWordAlias {
  my($self, $alias) = @_;
  my %x;

  my $retVal;
  $alias = "\L$alias\E";
  $self->beginReadWork("main");
  my(%aliases) = %{$self->{main}{wordAliases}};
  $retVal =  $aliases{$alias};
  $self->endReadWork("main");
  return $retVal;
}

sub setWordAlias {
  my($self, $alias, $word) = @_;
  my %x;

  my $retVal;
  $alias = "\L$alias\E";
  $word = "\L$word\E";
  $self->beginWriteWork("main");
  my(%aliases) = %{$self->{main}{wordAliases}};

  $aliases{$alias} = $word;
  $self->{main}{wordAliases} = \%aliases;
  $self->endWriteWork("main");
  print "just set word alias, \"$alias\" to \"$word\"\n";
  return $word;
}


sub getPendingEntriesByUser {
  my $self = shift;
  my $user = shift;

  $self->beginReadWork("pending");

  my $userH = $self->getUserHandle($user);
  $self->endReadWork("pending");
  if (not defined $userH) {
    return undef;
  }
  return $self->getPendingEntriesByUserHandle($userH);

}

sub getPendingEntriesByUserHandle {
  my $self = shift;
  my $userHandle = shift;

  $self->beginReadWork("pending");

  my(%entries) = %{$self->{'pending'}{entries}};
  $self->endReadWork("pending");

  my(%x) = %{$entries{byUser}{$userHandle}};
  # return database fields
  foreach my $key (keys %x) {
    # FIXME: boy, this is really cheating...
    bless $x{$key}, "SFLC::TimeTracker::Entry";
  }
  return \%x;

}

###############################################################################
sub getUserConfigValue {
  my($self, $userHandle, $config) = @_;

  $self->beginReadWork("main");

  my(%x) = %{$self->{main}{userConfig}{$userHandle}};
  $self->endReadWork("main");
  carp "$config not set fo $userHandle" if (not defined $x{$config});
  return $x{$config};
}
###############################################################################
sub setUserConfigValue {
  my($self, $userHandle, $config, $value) = @_;

  $self->beginWriteWork("main");

  my(%x) = %{$self->{main}{userConfig}};
  $x{$userHandle}{$config} = $value;
  $self->{main}{userConfig} = \%x;
  $self->endWriteWork("main");
  return $value;
}
###############################################################################

sub _uniquifyId {
  my($self, $id) = @_;

  $self->beginWriteWork("main");
  my(%ids) = %{$self->{main}{ids}};
  $ids{$id} = -1 unless (defined $ids{$id});

  $id =  "${id}-" . ++$ids{$id};
  $self->{main}{ids} = \%ids;
  $self->endWriteWork("main");

  return $id;
}

sub insertEntry {
  my($self, $db, $entry) = @_;

  croak "invalid $db" unless defined $self->{$db};
  croak "cannot insert entry without userHandle"
    unless defined $entry->{userHandle};
  if (not defined $entry->{id}) {
    if (defined $entry->{startTime}) {
      $entry->{id} = $entry->{startTime};
    } elsif (defined $entry->{endTime}) {
      $entry->{id} = $entry->{endTime};
    } else {
      $entry->{id} = ParseDateString("now");
    }
    $entry->{id} =  $self->_uniquifyId($entry->{id});
  }

#  my(%entCopy) = %{$entry};  # be sure we get a copy
#  bless \%entCopy, "SFLC::TimeTracker::Entry";
#  delete $entCopy{database};
  delete $entry->{database};
  $self->beginWriteWork($db);
  my(%entries) = %{$self->{$db}{entries}};
#  $entries{byUser}{$entry->{userHandle}}{$entry->{id}} = \%entCopy;
#  $entries{byCategory}{$entry->{category}}{$entry->{id}} = \%entCopy
#    if ($db eq "main");
  $entries{byUser}{$entry->{userHandle}}{$entry->{id}} = $entry;
  $self->{$db}{entries} = \%entries;
  $self->endWriteWork($db);
  return $entry->{id};
}

sub getEntryById {
  my($self, $userHandle, $id) = @_;

  croak "cannot lookup entry without userHandle" unless defined $userHandle;

  my $entry;
  foreach my $db (qw/pending main/) {
    $self->beginReadWork($db);
    my(%entries) = %{$self->{$db}{entries}};
    $self->endReadWork($db);
    $entry = $entries{byUser}{$userHandle}{$id};
    if (defined $entry) {
      # FIXME: boy, this is really cheating...
      bless $entry, "SFLC::TimeTracker::Entry";
      return $entry;
    }
  }
  return $entry;
}

sub getLastEntry {
  my($self, $userHandle) = @_;

  croak "cannot lookup entry without userHandle" unless defined $userHandle;

  my $entry;
  my $db =  "main";
  $self->beginReadWork($db);

  my(%entries) = %{$self->{$db}{entries}};

  my $foundEntry;
  foreach my $key (sort { $b cmp $a } keys %{$entries{byUser}{$userHandle}}) {
    my $entry = $entries{byUser}{$userHandle}{$key};
    bless $entry, "SFLC::TimeTracker::Entry";
    $foundEntry = $entry;
    last;
  }
  $self->endReadWork($db);
  return $foundEntry;
}

sub getLastEntryWithCategory {
  my($self, $userHandle, $categoryHandle) = @_;

  croak "cannot lookup entry without userHandle" unless defined $userHandle;

  my $entry;
  my $db =  "main";
  $self->beginReadWork($db);

  my(%entries) = %{$self->{$db}{entries}};

  my $foundEntry;
  foreach my $key (sort { $b cmp $a } keys %{$entries{byUser}{$userHandle}}) {
    my $entry = $entries{byUser}{$userHandle}{$key};
    bless $entry, "SFLC::TimeTracker::Entry";
    my $curCatID = $entry->get('category')->get('id');
    if ($categoryHandle eq $curCatID) {
      $foundEntry = $entry;
      last;
    }
  }
  $self->endReadWork($db);
  return $foundEntry;
}
###############################################################################

sub getUserList {
  my($self) = @_;

  $self->beginReadWork("main");
  my(%entries) = %{$self->{'main'}{entries}};
  $self->endReadWork('main');
  return keys %{$entries{byUser}};
}
###############################################################################
sub getEntriesOnDateWithCategory {
  my($self, $userHandle, $date, $categoryHandle) = @_;

  my $soughtDate = UnixDate($date, "%Y-%m-%d");

  croak "cannot lookup entry without userHandle" unless defined $userHandle;

  my $entry;
  my $db =  "main";
  $self->beginReadWork($db);

  my(%entries) = %{$self->{$db}{entries}};

  my @foundEntries;

  foreach my $entry (values %{$entries{byUser}{$userHandle}}) {
    bless $entry, "SFLC::TimeTracker::Entry";
    my $dateOccurred = $entry->get('dateOccurred');
    my $category = $entry->get('category');
    warn("no  date occured for entry ID " . $entry->{id})
      unless defined $dateOccurred;
    if ($dateOccurred eq $soughtDate) {
      my $curCatID = $entry->get('category')->get('id');
      push(@foundEntries, $entry) if ($categoryHandle eq $curCatID);
    }
  }
  $self->endReadWork($db);
  return @foundEntries;
}
###############################################################################
sub getEntriesOnDateInDB {
  my($self, $db, $userHandle, $date) = @_;

  my $soughtDate = UnixDate($date, "%Y-%m-%d");

  croak "cannot lookup entry without userHandle" unless defined $userHandle;

  my $entry;

  $self->beginReadWork($db);

  my(%entries) = %{$self->{$db}{entries}};

  my @foundEntries;

  foreach my $entry (values %{$entries{byUser}{$userHandle}}) {
    bless $entry, "SFLC::TimeTracker::Entry";
    my $dateOccurred = $entry->get('dateOccurred');
    warn("no  date occured for entry ID " . $entry->{id})
      unless defined $dateOccurred;
    push(@foundEntries, $entry) if ($dateOccurred eq $soughtDate);
  }
  $self->endReadWork($db);
  return @foundEntries;
}
###############################################################################
sub getEntriesWithNote {
  my($self, $db, $userHandle, $soughtNote) = @_;

  croak "cannot lookup entry without userHandle" unless defined $userHandle;

  my $entry;

  $self->beginReadWork($db);

  my(%entries) = %{$self->{$db}{entries}};

  my @foundEntries;

  foreach my $entry (values %{$entries{byUser}{$userHandle}}) {
    bless $entry, "SFLC::TimeTracker::Entry";
    my $note = $entry->get('note');
    push(@foundEntries, $entry) if ($note !~ /^\s*$/ and
                                    $note eq $soughtNote);
  }
  $self->endReadWork($db);
  return @foundEntries;
}

###############################################################################
sub getEntriesInDateRange {
  my($self, $db, $userHandle, $startDate, $endDate) = @_;

  $startDate = UnixDate($startDate, "%Y-%m-%d");
  $endDate = UnixDate($endDate, "%Y-%m-%d");

  croak "cannot lookup entry without userHandle" unless defined $userHandle;

  my $entry;

  $self->beginReadWork($db);

  my(%entries) = %{$self->{$db}{entries}};

  my @foundEntries;

  foreach my $entry (values %{$entries{byUser}{$userHandle}}) {
    bless $entry, "SFLC::TimeTracker::Entry";
    my $dateOccurred = $entry->get('dateOccurred');
    warn("no  date occured for entry ID " . $entry->{id})
      unless defined $dateOccurred;
    push(@foundEntries, $entry) if ($dateOccurred ge $startDate and
                                    $dateOccurred le $endDate);
  }
  $self->endReadWork($db);
  return @foundEntries;
}


sub removeQuestion {
  my($self, $question) = @_;

  croak "cannot insert entry without userHandle"
    unless defined $question->{userHandle};
  if (not defined $question->{id}) {
      $question->{id} = "QUES-" . ParseDateString("now");
      $question->{id} =  $self->_uniquifyId($question->{id});
  }

  delete $question->{database};
  $self->beginWriteWork("pending");
  my(%entries) = %{$self->{"pending"}{questions}};
  delete $entries{users}{$question->{userHandle}}{list}{$question->{id}};
  $self->{'pending'}{questions} =  \%entries;
  $self->endWriteWork('pending');
  return undef;
}

sub insertQuestion {
  my($self, $question) = @_;

  croak "cannot insert entry without userHandle"
    unless defined $question->{userHandle};
  if (not defined $question->{id}) {
      $question->{id} = "QUES-" . ParseDateString("now");
      $question->{id} =  $self->_uniquifyId($question->{id});
  }

  $self->beginWriteWork("pending");
  my(%entries) = %{$self->{"pending"}{questions}};
  $entries{users}{$question->{userHandle}}{list}{$question->{id}} = $question;
  $self->{'pending'}{questions} =  \%entries;
  $self->endWriteWork('pending');
  return $question->{id};
}

sub updateQuestion {
  my($self, $question) = @_;

  croak "cannot insert entry without userHandle"
    unless defined $question->{userHandle};
  croak "cannot update question without ID" if (not defined $question->{id});

  $self->beginWriteWork("pending");
  my(%entries) = %{$self->{"pending"}{questions}};
  $entries{users}{$question->{userHandle}}{list}{$question->{id}} = $question;
  $self->{'pending'}{questions} =  \%entries;
  $self->endWriteWork('pending');
  return $question->{id};
}

sub getOldestQuestion {
  my($self, $userHandle) = @_;

  croak "cannot insert entry without userHandle"
    unless defined $userHandle;
  $self->beginReadWork("pending");
  my(%entries) = %{$self->{"pending"}{questions}{users}{$userHandle}{list}};
  $self->endReadWork('pending');
  my(@list) = values %entries;
  return undef if @list <= 0;
  my(@sorted) = sort {$a->{id} cmp $b->{id} } @list;
  return $sorted[0];
}

sub shiftInteractionTree {
  my($self, $userHandle) = @_;

  $self->beginWriteWork("pending");

  my(%intTrees) = %{$self->{pending}{interactionTrees}};

  if (not defined $intTrees{$userHandle}) {
    $self->endWriteWork("pending");
    croak "unable to find interaction tree list for $userHandle";
  }
  my $obj = shift @{$intTrees{$userHandle}};

  $self->{pending}{interactionTrees} = \%intTrees;
  $self->endWriteWork("pending");

  return $obj;
}
sub unshiftInteractionTree {
  my($self, $userHandle, $obj) = @_;

  $self->beginWriteWork("pending");

  my(%intTrees) = %{$self->{pending}{interactionTrees}};

  if (not defined $intTrees{$userHandle}) {
    $self->endWriteWork("pending");
    croak "unable to find interaction tree list for $userHandle";
  }
  unshift(@{$intTrees{$userHandle}}, $obj);
  $self->{pending}{interactionTrees} = \%intTrees;
  $self->endWriteWork("pending");
}

sub setCurrentQuestion {
  my($self, $question) = @_;

  croak "cannot insert entry without userHandle"
    unless defined $question->{userHandle};
  if (not defined $question->{id}) {
      $question->{id} = "QUES-" . ParseDateString("now");
      $question->{id} =  $self->_uniquifyId($question->{id});
  }

  $self->beginWriteWork("pending");
  my(%entries) = %{$self->{"pending"}{questions}};
  $entries{users}{$question->{userHandle}}{current} = $question->{id};
  $self->{'pending'}{questions} =  \%entries;
  $self->endWriteWork('pending');
  return $question->{id};
}

sub unsetCurrentQuestion {
  my($self, $userHandle) = @_;

  $self->beginWriteWork("pending");
  my(%entries) = %{$self->{"pending"}{questions}};
  $entries{users}{$userHandle}{current} = undef;
  $self->{'pending'}{questions} =  \%entries;
  $self->endWriteWork('pending');
  return undef;
}

sub getCurrentQuestion {
  my($self, $userHandle) = @_;

  $self->beginReadWork("pending");
  my $id = $self->{pending}{questions}{users}{$userHandle}{current};

  my $copy;
  $copy = (defined $id)
             ? $self->{pending}{questions}{users}{$userHandle}{list}{$id}
             : undef;
  $self->endReadWork("pending");
  return $copy;
}

sub stackPush {
  my($self, $entry) = @_;

  croak "cannot insert entry without userHandle"
    unless defined $entry->{userHandle};
  croak "cannot push entry without existing ID"
    unless defined $entry->{id};

  $self->beginWriteWork("pending");
  my(@stack) = @{$self->{pending}{configs}{users}{$entry->{userHandle}}{stack}};
  my $total = push(@stack, $entry);
  $self->{pending}{configs}{users}{$entry->{userHandle}}{stack} = \@stack;
  $self->endWriteWork("pending");
  return $total;
}

sub stackPop {
  my($self, $userHandle) = @_;

  croak "cannot insert entry without userHandle" unless defined $userHandle;

  $self->beginWriteWork("pending");
  my(@stack) = @{$self->{pending}{configs}{users}{$userHandle}{stack}};
  my $item = pop(@stack);
  $self->{pending}{configs}{$userHandle}{stack} = \@stack;
  $self->endWriteWork("pending");
  return $item;
}

sub stackClear {
  my($self, $userHandle) = @_;

  croak "cannot insert entry without userHandle" unless defined $userHandle;

  $self->beginWriteWork("pending");
  my(%configs) = %{$self->{pending}{configs}};
  $configs{users}{$userHandle}{stack} = [];
  $self->{pending}{configs} = \%configs;

  $self->endWriteWork("pending");
  return ();
}


sub stackList {
  my($self, $userHandle) = @_;

  croak "cannot insert entry without userHandle" unless defined $userHandle;

  $self->beginReadWork("pending");
  my(@stack) = @{$self->{pending}{configs}{users}{$userHandle}{stack}};
  $self->endReadWork("pending");
  return @stack;
}

sub updateEntry {
  my($self, $db, $entry) = @_;

  croak "invalid $db" unless defined $self->{$db};
  croak "cannot insert entry without userHandle"
    unless defined $entry->{userHandle};
  croak "cannot update entry without existing ID"
    unless defined $entry->{id};

#  my(%entCopy) = %{$entry};  # be sure we get a copy
#  delete $entCopy{database};
  delete $entry->{database};
  # If we have now completed the entry, we should move it the main DB, and remove
  # it from pending
  if ($entry->isComplete() and $db eq "pending") {
    print STDERR "MOVING $entry->{id} to MAIN\n";
    $self->removeEntry($db, $entry);
    $db = "main";
    $entry->{inDB} = $db;
  }
  $self->beginWriteWork($db);
  my(%entries) = %{$self->{$db}{entries}};
#  $entries{byUser}{$entry->{userHandle}}{$entry->{id}} = \%entCopy;
#  $entries{byCategory}{$entry->{category}}{$entry->{id}} = \%entCopy
#    if ($db eq "main");
  $entries{byUser}{$entry->{userHandle}}{$entry->{id}} = $entry;
  $self->{$db}{entries} = \%entries;
  $self->endWriteWork($db);
  return $db;
}
sub removeEntry {
  my($self, $db, $entry) = @_;

  croak "invalid $db" unless defined $self->{$db};
  croak "cannot remove entry without existing ID"
    unless defined $entry->{id};

  $self->beginWriteWork($db);
  my(%entries) = %{$self->{$db}{entries}};
  delete $entries{byUser}{$entry->{userHandle}}{$entry->{id}};
  $self->{$db}{entries} = \%entries;
  $self->endWriteWork($db);
  return undef;
}

sub mergeCategory {
  my($self, $from, $into) = @_;

  croak "bad argument to mergeCategory" 
    unless ref $from eq "SFLC::TimeTracker::Category" and
      ref $into eq "SFLC::TimeTracker::Category";

  $self->beginWriteWork("main");
  $self->beginWriteWork("pending");

  # First, remove the "from" merger  outright from the category list
  my %catList = %{$self->{main}{categoryList}};
  delete $catList{$from->{id}};
  $self->{main}{categoryList} = \%catList;

  # Next, correct aliases that point to it ... first for users ..
  my %aliases = %{$self->{main}{categoryAliases}};
  foreach my $user (keys %{$aliases{users}}) {
    foreach my $cat (keys %{$aliases{users}{$user}}) {
      $aliases{users}{$user}{$cat} = $into->{id}
      if ($aliases{users}{$user}{$cat} eq $from->{id});
    }
  }
  # .. then global ..
  foreach my $cat (keys %{$aliases{GLOBAL}}) {
    $aliases{GLOBAL}{$cat} = $into->{id}
      if ($aliases{GLOBAL}{$cat} eq $from->{id});
  }
  $self->{main}{categoryAliases} = \%aliases;

  # Make a global alias that points from the old name to the new one.

  $self->setGlobalCategoryAlias($from->{name}, $into);

  foreach my $db (qw/main pending/) {
    my %entries = %{$self->{$db}{entries}};
    foreach my $user (keys %{$entries{byUser}}) {
      foreach my $id (keys %{$entries{byUser}{$user}}) {
        my $entry = $entries{byUser}{$user}{$id};
        my $cat = $entry->{category};
        next if not defined $cat and $db eq "pending";
        if ($entry->{category} eq $from->{id}) {
          $entry->{category} = $into->{id};
        }
      }
    }
    $self->{$db}{entries} = \%entries;
  }
  $self->{main}{categoryChanged} = time();
  $self->endWriteWork("main");
  $self->endWriteWork("pending");
}

sub insertCategory {
  my($self, $category) = @_;

  if (not defined $category->{id}) {
    $category->{id} = $self->_uniquifyId($category->{name});
  }
  $self->beginWriteWork("main");
  my(%x) = %{$self->{main}{categoryList}};
  my(%aliases) = %{$self->{main}{categoryAliases}};
  $x{$category->{id}} = $category;
  $aliases{GLOBAL}{$category->{name}} = $category->{id};

  $self->{main}{categoryList} = \%x;
  $self->{main}{categoryAliases} = \%aliases;

  $self->{main}{categoryChanged} = time();

  $self->endWriteWork("main");

  return $category->{id};
}

###############################################################################
sub getCategoryLevel {
  my($self, $userHandle, $level) = @_;

  croak "user handle required to lookup category level"
    unless defined $userHandle;

  $self->beginReadWork("main");

  croak "no category alias list for $userHandle"
    unless defined $self->{main}{categoryAliases}{users}{$userHandle};

  my @cats;
  push(@cats, keys %{$self->{main}{categoryAliases}{users}{$userHandle}});
  push(@cats, keys %{$self->{main}{categoryAliases}{GLOBAL}});

  my(@found) = grep(/^$level\//, @cats);
  @found = grep(/^$level/, @cats) if (@found <= 0);

  # The second of the two lines is basically for "backwards
  # compatibility".  That grep was written the second way since this
  # function was first written, and I don't know if other parts of the
  # code rely on it to work for full path names that don't end in a /.  I
  # think the logic is now correct, since it searches for a "level" first,
  # and then extends it if nothing is found.  -- bkuhn, 2007-10-24

  my %noDups;
  @noDups{@found} = @found;
  @found = keys %noDups;

  $self->endReadWork("main");
  return @found;
}
###############################################################################
sub getCategoryLevelNoAliases {
  my($self, $level) = @_;

  $self->beginReadWork("main");

  my @cats;
  foreach my $catKey (keys %{$self->{main}{categoryList}}) {
    my $category = $self->{main}{categoryList}{$catKey};
    push(@cats, $category->{name});
  }
  my(@found) = grep(/^$level\//, @cats);
  @found = grep(/^$level/, @cats) if (@found <= 0);


  # The second of the two lines is basically for "backwards
  # compatibility".  That grep was written the second way since this
  # function was first written, and I don't know if other parts of the
  # code rely on it to work for full path names that don't end in a /.  I
  # think the logic is now correct, since it searches for a "level" first,
  # and then extends it if nothing is found.  -- bkuhn, 2007-10-24

  my %noDups;
  @noDups{@found} = @found;
  @found = keys %noDups;

  $self->endReadWork("main");
  return @found;
}
###############################################################################
sub updateCategory {
  my($self, $category) = @_;

  if (not defined $category->{id}) {
    croak "cannot update category that has not yet been assigned an ID";
  }
  $self->beginWriteWork("main");
  my(%x) = %{$self->{main}{categoryList}};
  my(%aliases) = %{$self->{main}{categoryAliases}};

  $x{$category->{id}} = $category;
  $aliases{GLOBAL}{$category->{name}} = $category->{id};

  $self->{main}{categoryList} = \%x;
  $self->{main}{categoryAliases} = \%aliases;

  $self->{main}{categoryChanged} = time();
  $self->endWriteWork("main");
  return $category->{id};
}

sub clearIRCData {
  my($self) = @_;

  $self->beginWriteWork("pending");
  my %stuff;
  foreach my $user (@VALID_USERS) {
    $stuff{$user} = {};
  }
  $self->{pending}{ircData} = \%stuff;

  $self->endWriteWork("pending");
}


sub clearInteractionTrees {
  my($self) = @_;

  $self->beginWriteWork("pending");
  my %stuff;
  foreach my $user (@VALID_USERS) {
    $stuff{$user} = [];
  }
  $self->{pending}{interactionTrees} = \%stuff;

  $self->endWriteWork("pending");
}

sub setIRCDataForUserHandle {
  my($self, $userHandle, $data) = @_;

  use Data::Dumper;
  print "IN setIRCDataForUserHandle, setting $userHandle to: ",
    Data::Dumper->Dump([$data]);
  $self->beginWriteWork("pending");
  my(%ircData) =  %{$self->{pending}{ircData}};
  $ircData{$userHandle} = $data;
  $self->{pending}{ircData} = \%ircData;
  $self->endWriteWork("pending");
}
sub getIRCDataForUserHandle {
  my($self, $userHandle) = @_;

  $self->beginReadWork("pending");
  my (%ircData) =  %{$self->{pending}{ircData}};
  $self->endReadWork("pending");
  return $ircData{$userHandle};
}
###############################################################################

=item __CREATE_INITIAL

usage: __CREATE_INITIAL

A function to create initial information that we know.  This is hard coded
and should be fixed to an external maintenance program in the future