% DemogTrak.pm-Copyright 1997-2000 Regents of the University of California
%  All rights reserved.
%  Author: Andrew J. Perrin (aperrin@demog.berkeley.edu)
%  This code may be distributed and used as long as credit and copyright
%  notices are preserved.

=head1 DemogTrak.pm - top-level module for manipulating DemogTrak databases.

=cut

=head1 USAGE:

=over 4

use DemogTrak;

$ch = new Channel;   # connect to the postgres backend. No arguments.

$me = new Person;    # create a new Person object...
$me = new Person(\%hash); # or create one with the info in %hash.

$me->fill(\%hash);   # fill an existing Person object with the info in %hash.

$me = get Person($where, $ch) #return (the first) Person that matches $where.
@we = get Person($where, $ch) #return an array of Persons that match $where.

Person->put($ch);    # add or update Person's record, return the id.
When using the put method, keys beginning with an underscore (_) are
ignored. This allows you to put junk in a record that won't ever be
inserted into the database.  As a convenience, an Event record 
provides eight such entries, _spec1name through _spec8name, which 
are the specs from the event type for that event.


for all of the above, substitute for Person:
Event
EventType
FundingSource

Debugging options:
- Set $Channel::_debug to 1 to produce verbose debugging output.
- Channel->trace to set or change SQL-level tracing.
- Set $Channel::_nosql to 1 to suppress routine output of SQL session.

=cut


$SIG{'__WARN__'} = sub { 
  use Tk;
  require Mail::Internet;
  return if $_[0] =~ /uninitialized/;
  if ($Channel::_debug) {
    warn "DemogTrak message: $_[0]";
  } else {
    my $mw = new MainWindow;
    $mw->withdraw;
    my $warnbox = $mw->Dialog(-title => 'DemogTrak Warning',
			      -text => $_[0] . "\nIf you do not understand" .
			      ' this message, click the Report to Trouble ' .
			      'button for help.',
			      -default_button => 'OK',
			      -buttons=>['OK',
					 'Report to Trouble']
			     );
    my $answer = $warnbox->Show;
    if ($answer eq 'Report to Trouble') {
      my @lines = join("\n",
		       'DemogTrak Trouble Report',
		       'Time: ' . &DemogTrak::now ,
		       'User: ' . $Channel::user ,
		       undef,
		       'Message:',
		       $_[0],
		       '-----',
		       'Context:');
      for (1..3) {
	my (@caller) = caller($_);
	push(@lines, "\n",
	     join("\n",
		  "\tLevel $_",
		  "\tpackage: $caller[0]",
		  "\tfilename: $caller[1]",
		  "\tline: $caller[2]",
		  "\tsubroutine: $caller[3]",
		  "\thasargs: $caller[4]",
		  "\twantarray: $caller[5]",
		  "\tevaltext: $caller[6]",
		  "\tis_require: $caller[7]"));
      }
      my $msg = new Mail::Internet;
      my $host = 'smtp.demog.berkeley.edu';
      $host = 'smtp.mindspring.com' if $^O =~ /win/i;
      $msg->replace('To', 'trouble@demog.berkeley.edu');
      $msg->replace('From', "$Channel::user\@demog.berkeley.edu");
      $msg->replace('Subject', 'DemogTrak Warning');
      $msg->replace('Reply-To', "$Channel::user\@demog.berkeley.edu");
      $msg->body(\@lines);
      $msg->smtpsend(Host=>$host,
		     To=>'trouble@demog.berkeley.edu');
      print STDERR "\n*****\n\n";
      print STDERR "Mailed to trouble:\n";
      print STDERR join("\n", @lines);
      print STDERR "\n\n*****\n\n";
    }
    $mw->destroy;
  }
};

package DemogTrak;
require Exporter;
use Date::Manip;

@ISA=qw/Exporter/;
@EXPORT_OK=qw/Getname Shortdate now safeTeX dispatch min max students no_logger/;
@EXPORT=qw/$junk/;

my $junk;

sub import {
print STDERR "import @_\n";
  my($mod, @sym) = @_;
  my $symbols = join("\t", @sym);
  if ($symbols =~ /no_logger/i) {
    $symbols =~ s/no_logger//gi;
    @sym = split(/\t+/, $symbols);
  } else {
    unless ($^O =~ /win/i) {
      open(STDERR, '| /home/davis/app2/dt2/log.pl') || die "Ouch! $!\n";
    }
  }
  DemogTrak->export_to_level(1,@_);
}
  
###--------
## ValidDate; ValidDateCallBack; ResetColorDateWidget are designed
## for use in a MUCH simpler date entry widget -- which replaces the elegant
## yet not quite actually properly working DateEntry widget. The game is for 
## a lowly Entry widget to bind FocousOut and Key such that the widet whines if 
## a not so great date is entered.
## -- carlm 10/25/00
###


sub ValidDate{
  ## returns 1 if date will be accepted for date_time type vars undef otherwise
  ## for use in improved widget for Date entry
  my $args;
  %$args=@_;
  my $dbh=new Channel;
  local $dbh->{PrintError}=0 if $dbh->{PrintError};
  my $sql='SELECT '.$dbh->quote($args->{-date}).'::date';
  return($dbh->do($sql));
}

sub VetDateCallBack{ 
  ## Used in Entry Widget where Text should be bound to 
  ## <FocusOut> on entry widget
  my $self=shift(@_);
  my $dstring=$self->get;
  if ( ! ValidDate(-date=>$dstring)){
    $self->focus();
    $self->bell();
    $self->configure(-fg=>'red');
  }
}

sub ResetColorDateWidget{
  ## resets color -- should be bound to "<Key>" event
  my $self = shift(@_);
  $self->configure(-fg=>'black');
}
###
## return now to DemogTrak
###
sub no_logger {
}

sub Getname {
  my $id = shift;
  my $person = Person->getfromid($id, new Channel);
  return $person->namestring;
}

sub Shortdate {
  #take a postgres-style date, return a short date.
  return '' unless defined $_[0];
#  my($dy,$month,$day,$time,$year,$tz) = split(/\s+/, $_[0]);
#  return "$month $day, $year";
  my($date,$time)=split(/\s+/,$_[0]);
  return $date;

}

sub now {
  #return the postgres system time.
  my $dbh = new Channel;
  my $sth = $dbh->prepare('SELECT now()');
  $sth->execute;
  my $now = $sth->fetchrow_arrayref;
  if ($now) {
    $now = $now->[0];
    $now = $1 if $now =~ /(.*)-.*/;
    return $now;
  } else {
    return undef;
  }
}

sub safeTeX {
  my @in = @_;
  my $debug = 0;
  foreach my $in (@in) {
    $debug && warn "safeTeX: in is $in";
    $in =~ s/([&\#%\$])/\\$1/g;
    $debug && warn "safeTeX: out is $in";
  }
  return @in;
}

sub dispatch {
  require FindBin;
  my $script = shift;
  my $foreground = shift;
  my $homepath = $FindBin::Bin;
  $script .= ' debug' if $Channel::_debug;
  $script .= ' trace' if $Channel::_trace;
  my $cmd = "$homepath/$script";
  $cmd .= ' &' unless $foreground;
  warn "dispatch $cmd" if $Channel::_debug;
  system("perl $cmd");
}

sub min {
  my $min=$_[0];
  $min > $_ and $min = $_ foreach @_;
  return $min;
}

sub max {
  my $max=$_[0];
  $max < $_ and $max = $_ foreach @_;
  return $max;
}

sub students {
  my($begin, $end) = @_;
  $begin = &UnixDate('today','%e-%b-%Y') unless $begin;
  my $where;
  $where = <<ENDSQL
EXISTS
  (SELECT id FROM event_detail WHERE id = personal_data.id AND
   date_effective >= '$begin'::date -
   '2 years'::interval)
AND NOT EXISTS
  (SELECT id FROM event_detail,event_universe WHERE id=personal_data.id AND
   event_detail.eventtypeid=event_universe.eventtypeid AND
   event_universe.studentstatus LIKE 'NotStudent' AND
   event_detail.date_effective<='$begin'::datetime)
AND EXISTS
  (SELECT id FROM event_detail,event_universe WHERE id=personal_data.id AND
   event_detail.eventtypeid=event_universe.eventtypeid AND 
   event_universe.studentstatus LIKE 'Student'
ENDSQL
;
  if ($end) {
  $where .= <<ENDSQL
   AND event_detail.date_effective<='$end'::datetime)
ENDSQL
} else {
  $where .= ')';
}
  return Person->get($where,undef,'last_name, first_name');
  
}

package Channel;
use DBI;
use vars qw/$_debug $channel $user $pw $_trace $_nosql/;

sub new {
  return $Channel::channel if $Channel::channel;
  my $mod = shift;
  my $Rparam = shift;
  if (ref $Rparam eq 'HASH') {
    $Channel::user = $Rparam->{user} if exists $Rparam->{user};
    $Channel::_trace = $Rparam->{trace} if exists $Rparam->{trace};
    $Channel::_debug = $Rparam->{debug} if exists $Rparam->{debug};
  }
  $Channel::_debug && warn 'Channel::new';
  $Channel::user = getlogin unless $Channel::user;
  $Channel::user = (getpwuid($>))[0] unless $Channel::user;
  return undef unless $Channel::user;
  if ($^O =~ /win/i) { #windows user
     print 'Enter postgres password: ';
     chomp($pw = <STDIN>);
     $Channel::pw = $pw;
     $dbh=DBI->connect('dbi:Pg:dbname=demogdata;host=xxxx',
		       $Channel::user, $Channel::pw);
  } else {
    $dbh = DBI->connect("dbi:Pg:dbname=demogdata", $Channel::user);
  }
  $dbh->trace($Channel::_trace) if $Channel::_trace;
  $Channel::channel = $dbh;
  return $dbh;
}

sub trace {
  my $ch = shift;
  return undef unless ref $ch;
  if (@_) {
    my $trace = shift;
    $Channel::_trace = $trace;
    $ch->trace($Channel::_trace);
  }
  return $Channel::_trace;
}

1;

package Record;
# generic class Record for consolidating classes.

sub _table {
# returns the appropriate table for a record
  my $rec = shift;
  my $type;
  if (ref($rec)) {
    $type = ref($rec);
  } else {
    $type = $rec;
  }
  my %tables = ( Person        => 'personal_data' ,
		 Event         => 'event_detail' ,
		 EventType     => 'event_universe' ,
		 FundingSource => 'funding_universe',
		 Template => 'templates');
  return $tables{$type};
}

sub _id {
# returns the unique id field for the record's table
  my $rec = shift;
  my $type;
  if (ref($rec)) {
    $type = ref($rec);
  } else {
    $type = $rec;
  }
  my %ids =    ( Person        => 'id' ,
		 Event         => 'event_id' ,
		 EventType     => 'eventtypeid' ,
		 FundingSource => 'sourceid',
		 Template => 'tid' );
  return $ids{$type};
}

sub _defined_fields {
  #returns an array of fields that are not undef in a record.
  # 3/8/01 bypassed in ->put method by carlm to allow users to delete 
  # information such as addressA2
  my $rec = shift;
  my @out;
  foreach (keys %$rec) {
    push(@out,$_) if defined $rec->{$_};
  }
  return @out;
}

sub _missing_fields {
  my $rec = shift;
  my @missing;
  foreach ($rec->required) {
    push(@missing,$_) unless defined $rec->{$_};
  }
  return @missing;
}

sub fill {
  $Channel::_debug && warn "fill: @_";
  my $record = shift;
  my $data = shift;
  my $noclobber = shift;
  return $record unless $data;
  foreach (keys %{$data}) {
    if (exists $data->{$_}) {
      if ($noclobber) {
	$record->{$_} = $data->{$_} unless defined $record->{$_};
      } else {
	$record->{$_} = $data->{$_};
      }
    }
  }
  return $record;
}

sub put {
  $Channel::_debug && warn "put: @_";
  my $record = shift;
  my $dbh = new Channel;
  my $sql;
  my $type = ref($record);
  if ($type eq 'Person' or
      $type eq 'Event') {
    $record->{updated} = $Channel::user . ' ' . DemogTrak::now;
  }
  my $id = $record->_id;
  my $table = $record->_table;
#  my @fields = $record->_defined_fields;
  my @fields = keys(%$record);
# 3/7/01 do insert/update on all fields including ones that have been
# set to blank by user e.g. addressA2


  if ($record->{$id}) {
    return -2 if @fields < 2;
    # we're editing an existing record
    $sql = "UPDATE $table SET ";
    foreach (keys %{$record}) {
      next if /^$id/i or /^_/;
#       3/7/01 - should be able to put nulls in database ..no?
#      if ((defined $record->{$_}) and ($record->{$_} !~ /^\s*$/)) {
      if ($record->{$_}=~m  /^\s*$/){
	$record->{$_}=undef;
      }
      $sql .= ', ' unless $sql =~ /SET\s+$/;
      $sql .= "$_ = " . $dbh->quote($record->{$_});
      
    }
    $sql .= " WHERE $id = " . $record->{$id};
    print STDERR "$sql\n" unless $Channel::_nosql;
    if ($dbh->prepare($sql)->execute) {
      return $record->{$id};
    } else {
      return undef;
    }
  } else {
    # we're adding a new record
    my @missing = $record->_missing_fields;
    if (@missing) {
      warn qq{ERROR: The following fields are required to save:\n\t@missing};
      return 0;
    }
    return -2 if @fields < 1;
    $sql = "INSERT INTO $table (";
    my @keys;
    foreach (sort grep(!/^_/, keys %{$record})) {
      push(@keys, $_) if defined $record->{$_};
    }
    $sql .= join(', ', @keys);
    $sql .= ') VALUES (';
    foreach (@keys) {
      next unless defined $record->{$_};
      $sql .= ', ' unless $sql =~ /\($/;
      $sql .= $dbh->quote($record->{$_});
    }
    $sql .= ')';
    print STDERR "$sql\n" unless $Channel::_nosql;
    if ($dbh->prepare($sql)->execute) {
      my $idh = $dbh->prepare(qq{SELECT currval('${table}_${id}_seq')});
      $idh->execute;
      my $idval = $idh->fetchrow_arrayref->[0];
      $record->{$id} = $idval;
      return $idval;
    } else {
      return undef;
    }
  }
}

sub get {
  # get a record from a where string. Trusts the where string.
  # Usually not called directly.
  $Channel::_debug && warn "get: @_";
  my $mod = shift;
  my $where = shift;
  my $dbh = shift;
  my $order = shift;
  $dbh = new Channel;
  my $foo = {};
  my $type = ref($mod);
  my $id = $mod->_id;
  my $table = $mod->_table;
  my (@out, $err);
  # connect to the db and get a hashref.
  my $sql = "SELECT * FROM $table";
  $sql .= " WHERE $where" if $where;
  $sql .= " ORDER BY $order" if $order;
  print STDERR "$sql\n" unless $Channel::_nosql;
  my $sth = $dbh->prepare($sql);
  $sth->execute;
  my @datefields;
  for my $i (1..$sth->{NUM_OF_FIELDS}) { #Checking for date fields to shorten
    push(@datefields,$sth->{NAME}->[$i-1]) if $sth->{TYPE}->[$i-1] == 1184;
  }
  my $Rrecords = $sth->fetchall_arrayref($foo);
  if ($sth) {
    foreach (@{$Rrecords}) {
      foreach my $field (@datefields) {
	$_->{$field} = DemogTrak::Shortdate($_->{$field});
      }
      push(@out, $mod->new($_));
    }
    wantarray ? return @out : return $out[0];
  } else {
    print STDERR "ERROR: ", $sth->errstr, "\n";
    return (0, $sth->errstr)
  }
}

sub remove {
  #delete a record based on id.
  $Channel::_debug && warn "remove: @_";
  my $mod = shift;
  my $dbh = new Channel;
  my $idfield = $mod->_id;
  my $table = $mod->_table;
  my $id = $mod->{$idfield};
  my $sql = qq{DELETE FROM $table WHERE $idfield = $id};
  print STDERR "$sql\n" unless $Channel::_nosql;
  my $sth = $dbh->prepare($sql);
  $sth->execute;
  undef %$mod;
}

sub reget {
  # insert a record based on where into an existing record's hash. Returns
  #  first record found.
  $Channel::_debug && warn "reget: @_";
  my $mod = shift;
  my $type = ref $mod;
  $type = $mod unless ref $mod;
  my $newrec = $type->get(@_);
  foreach (keys %$mod) {
    delete $mod->{$_} unless exists $newrec->{$_};
  }
  $mod->{$_} = $newrec->{$_} foreach keys %$newrec;
  return $mod;
}

sub renew {
  #insert a blank record of type mod into existing hash; populate if
  # appropriate.
  $Channel::_debug && warn "renew: @_";
  my $mod = shift;
  my $type = ref $mod;
  $type = $mod unless ref $mod;
  my $newrec = $type->new(@_);
  foreach (keys %$mod) {
    delete $mod->{$_} unless exists $newrec->{$_};
  }
  $mod->{$_} = $newrec->{$_} foreach keys %$newrec;
  return $mod;
}

sub getfromid {
  $Channel::_debug && warn "getfromid: @_";
  my $mod = shift;
  my $id = shift;
  return $mod->new() unless $id;
  my $dbh = new Channel;
  my $idfield = $mod->_id;
  my $where = "$idfield = $id";
  return $mod->get($where,$dbh);
}

sub regetfromid {
  $Channel::_debug && warn "regetfromid: @_";
  my $mod = shift;
  my $id = shift;
  my $dbh = new Channel;
  my $idfield = $mod->_id;
  my $where = "$idfield = $id";
  return $mod->reget($where,$dbh);
}

sub _lc {
  # make all keys lowercase
  $Channel::_debug && warn "_lc: @_";
  my $rec = shift;
  foreach my $field (keys %$rec) {
    delete $rec->{$field} unless (defined $rec->{$field} and
				  $rec->{$field} !~ /^\s*$/);
    my $newfield = lc $field;
    $newfield =~ s/(?:^\s*)|(?:\s*$)//g;
    unless ($newfield eq $field) {
      $rec->{$newfield} = $rec->{$field};
      delete $rec->{$field};
    }
  }
  return $rec;
}

sub diff {
  $Channel::_debug && warn "diff: @_";
  my $oldrec = shift;
  my $newrec = shift;
  $oldrec->_lc;
  my $type = ref $newrec;
  return undef unless ref ($oldrec) eq $type;
  my $idfield = $oldrec->_id;
  my $diffrec = $type->new({$idfield => $oldrec->{$idfield}});
  foreach my $field (keys %{$newrec}) {
    next unless defined $newrec->{$field};
    next if $field eq $idfield;
    if ((not defined $oldrec->{$field}) or
	($oldrec->{$field} ne $newrec->{$field}) ) {
      $diffrec->{$field} = $newrec->{$field};
    }
  }
  return $diffrec->_lc;
}

sub dumpout {
  my $rec = shift;
  my $suppressundef = shift;
  $suppressundef = 0 unless defined $suppressundef;
  print STDERR 'Dumping a ', ref($rec), "\n";
  foreach (sort keys %$rec) {
    if (defined $rec->{$_}) {
      print STDERR "$_  =>  $$rec{$_}\n";
    } else {
      print STDERR "$_  =>  >>undef<<\n" unless $suppressundef;
    }
  }
}

package Person;
@ISA=qw/Record/;

sub new {
  my $mod = shift;
  my %self;
  foreach (qw/
	   id
	   last_name
	   first_name
	   mi
	   institution
	   printinst
	   title
	   printtitle
	   addressa1
	   addressa2
	   campusa
	   campuscodea
	   citya
	   statea
	   zipa
	   countrya
	   addressb1
	   addressb2
	   campusb
	   campuscodeb
	   cityb
	   stateb
	   zipb
	   countryb
	   addressc1
	   addressc2
	   campusc
	   campuscodec
	   cityc
	   statec
	   zipc
	   countryc
	   useaddress
	   e_mail
	   home_phone
	   office_phone
	   office_ext
	   other_phone
	   other_ext
	   fax
	   ssn
	   sid
	   eid
	   sex
	   birthdate
	   faculty
	   exfaculty
	   student
	   exstudent
	   staff
	   exstaff
	   bacpop
	   brownbag
	   list1
	   list2
	   list3
	   list4
	   list5
	   list6
	   list7
	   list8
	   list9
	   list0
	   created
	   updated
	   deleted_on /) {
    $self{$_} = undef;
  }
  $person = \%self;
  bless $person, 'Person';
  $person->fill($_[0]) if $_[0];
  return $person;
}

sub required {
  return qw(first_name last_name);
}

sub namestring {
  my $person = shift;
  my $out = $person->{first_name};
  $out .= ' ' . $person->{mi} . ' ' if $person->{mi};
  $out .= ' ' . $person->{last_name};
  $out = '(New Record)' unless $out;
  return $out;
}

sub instline {
  my $person = shift;
  my $out = '';
  if ($person->{printtitle}) {
    $out .= $person->{title};
  }
  if ($person->{printinst}) {
    $out .= ', ' if $out;
    $out .= $person->{institution};
  }
  return $out;
}

sub get {
  #specialized get method to weed out pending deletes
  my ($mod, $where, $dbh, $order) = @_;
  if ($where) {
    $where = "deleted_on IS NULL AND $where";
  } else {
    $where = 'deleted_on IS NULL';
  }
  Record::get($mod, $where, $dbh, $order);
}

sub del {
  my($rec) = shift;
  # Check for child events before allowing
  my $id = $rec->{id};
  return undef unless defined $id;
  my @kids = Event->get("id = $id OR chair = $id OR member1 = $id " .
			"OR member2 = $id");
  if (@kids) {
    warn "Can't delete record for " . $rec->namestring .
      " because there are " . scalar @kids . " events stored. Refer " .
	' to administrator for help.';
    return undef;
  } else {
    $rec->{deleted_on} = &DemogTrak::now;
    return $rec->put;
  }
}

package Event;
@ISA=qw/Record/;

sub new {
  my $mod = shift;
  my %event;
  foreach ( qw/
	    event_id
	    eventtypeid
	    id
	    date_effective
	    date_expires
	    expected
	    title
	    sourceid
	    cost
	    spec1
	    spec2
	    spec3
	    spec4
	    spec5
	    spec6
	    spec7
	    spec8
	    comments
	    current_interests
	    updated
	    override
	    semester
 	    acadyear
	    chair
	    member1
	    member2
	    degree
	    expected / ) {
    $event{$_} = undef;
  }
  my $event = \%event;
  bless $event, 'Event';
  $event->fill ($_[0]);
  return $event;
}

sub required {
  my $rec = shift;
  my @req = qw(eventtypeid id date_effective);
  $rec->getspecnames unless exists $rec->{_spec1req};
  foreach (1..8) {
    push(@req, "spec$_") if (defined $rec->{"_spec${_}req"} &&
			     $rec->{"_spec${_}req"});
  }
  return @req;
}

sub get {
  # make the default order reverse date.
  my ($mod,$where,$dbh,$order) = @_;
  $order = 'date_effective DESC' unless $order;
  return Record::get($mod,$where,$dbh,$order);
}

sub getspecnames {
  # add the _spec?name keys to an Event hash.
  my $event = shift;
  if (defined $event->{eventtypeid}) {
    my $ch = new Channel;
    my $type = getfromid EventType($event->{eventtypeid},$ch);
    for (1..8) {
      $event->{"_spec${_}name"} = $type->{"spec${_}name"};
      $event->{"_spec${_}type"} = $type->{"spec${_}type"};
      $event->{"_spec${_}req"} = $type->{"spec${_}req"};
    }
    $event->{_event_name} = $type->{event_name};
    $event->{"_show${_}"} = $type->{"show${_}"} for
      ('title','cost','fundingsource','expires','semester',
       'acadyear','chair','member1','member2','degree');
  } else {
    for (1..8) {
      $event->{"_spec${_}name"} = undef;
      $event->{"_spec${_}type"} = undef;
      $event->{"_spec${_}req"} = undef;
    }
    $event->{"_show${_}"} = undef for
      ('title','cost','fundingsource','expires','semester',
       'acadyear','chair','member1','member2','degree');
  }
  return $event;
}

sub fill {
  #this modification to the Record::fill sub includes the spec
  # name types from eventtype.  Just a convenience, really. They
  # end up in $event->{_event?name} where ? is 1..8.
  my $event = shift;
  my $data = shift;
  Record::fill($event,$data);
  return $event->getspecnames;
}

sub htmlline {
  my $event = shift;
  my $out = $event->{date_effective};
  $out .= '-' . $event->{date_expires} 
    if $event->{date_expires};
  $out .= ' (<STRONG>Expected</strong>)' if $event->{expected};
  $out .= ': ' . $event->{_event_name} . ': ';
  foreach (1..8) {
    if (exists $event->{"_spec${_}name"} and
	defined $event->{"_spec${_}name"}) {
      $out .= $event->{"_spec${_}name"} . ': ';
      if (exists $event->{"spec$_"} and
	  defined $event->{"spec$_"}) {
	$out .= $event->{"spec$_"} . '. ';
      } else {
	$out .= '<STRONG>***MISSING***</STRONG> ';
      }
    }
  }
  $out .= '<BR>Title: ' . $event->{title} if $event->{title};
  return $out;
}

sub latexline {
  my $debug = 0;
  my $event = shift;
  my $out = $event->{_event_name} . "\n";
  my $specs = 0;
  $out .= '\\\\Title: ' . $event->{title} if defined $event->{title};
  foreach (1..8) {
    if (exists $event->{"_spec${_}name"} and
	defined $event->{"_spec${_}name"}) {
      unless ($specs) {
	$out .= "\\begin{itemize}\n";
	$specs = 1;
      }
      $out .= '\\item ' . $event->{"_spec${_}name"} . ': ';
      if (exists $event->{"spec$_"} and
	  defined $event->{"spec$_"}) {
	$out .= $event->{"spec$_"};
      } else {
	$out .= 'missing. ';
      }
      $out .= "\n";
    }
  }
  $out .= "\\end{itemize}\n" if $specs;
  return $out;
}

sub lineout {
  #depracated.
  return latexline(@_);
}

sub _oldlineout {
  my $event = shift;
  my $dbh = new Channel;
  my ($sth, $out, $i);
  $sth=$dbh->prepare
    ('SELECT ' .
     'spec1name, spec2name, spec3name, spec4name, ' .
     'spec5name, spec6name, spec7name, spec8name, ' .
     'event_name ' .
     'FROM event_universe WHERE eventtypeid = ' .
     $event->{eventtypeid});
  $sth->execute;
  my %specs = %{$sth->fetchrow_hashref};
  $out = $specs{event_name} . ": \\\\\n";
  foreach (keys %specs) {
    next unless (/^spec/ && ($specs{$_}));
    my $spec = $_;
    $spec = $1 if $spec =~ /(.*)name$/;
    if (exists $event->{$spec}) {
      $out .= $specs{$_} . ': ' . $event->{$spec} . '. ';
    } else {
      $out .= $specs{$_} . ': missing. ';
    }
  }
  return $out;
}

1;

package EventType;
@ISA=qw/Record/;

sub new {
  my $mod = shift;
  my $type;
  my %self;
  foreach (
	   'eventtypeid',
	   'oldeventtypeid',
	   'event_name',
	   'event_group',
	   'spec1name',
	   'spec2name',
	   'spec3name',
	   'spec4name',
	   'spec5name',
	   'spec6name',
	   'spec7name',
	   'spec8name',
	   'spec1type',
	   'spec2type',
	   'spec3type',
	   'spec4type',
	   'spec5type',
	   'spec6type',
	   'spec7type',
	   'spec8type',
	   'spec1req',
	   'spec2req',
	   'spec3req',
	   'spec4req',
	   'spec5req',
	   'spec6req',
	   'spec7req',
	   'spec8req',
	   'studentstatus',
	   'applicantstatus',
	   'funded',
	   'exclusive',
	   'isunique',
	   'funded',
	   'collective',
	   'isunique',
	   'showtitle',
	   'showcost',
	   'showfundingsource',
	   'showdateexpires',
	   'showsemester',
	   'showacadyear',
	   'showchair',
	   'showmember1',
	   'showmember2',
	   'showdegree'
	  ) {
    $self{$_} = undef;
  }
  $type = \%self;
  bless $type, 'EventType';
  $type->fill($_[0]) if $_[0];
  return $type;
}

sub required {
  return qw(event_name);
}

1;

package FundingSource;
@ISA=qw/Record/;

sub new {
  my $mod = shift;
  my %self;
  my $source;
  foreach (qw/
sourceid
acsourceid
source_name
nickname
description
granttitle
grantor
grantset
amount
date_awarded
date_expires
recipient
administering_department
comments
/) {
    $self{$_} = undef;
  }
  $source = \%self;
  bless $source, 'FundingSource';
  $source->fill($_[0]) if $_[0];
  return $source;
}

sub required {
  return qw(source_name);
}

package Template;
@ISA=qw/Record/;

sub new {
  my $mod = shift;
  my %self;
  my $source;
  foreach (qw/tid type time_covered checkedout whocheckedout checkedin
	      whocheckedin/) {
    $self{$_} = undef;
  }
  $source = \%self;
  bless $source, 'Template';
  $source->fill($_[0]) if $_[0];
  return $source;
}

sub required {
  return ();
}

sub checkout {
  my $mod = shift;
  my $data = shift;
  return undef unless (defined $data->{time_covered} and defined $data->{type});
  my $found = $mod->get("time_covered LIKE '$$data{time_covered}' AND " .
			"type LIKE '$$data{type}' AND checkedin IS NULL");
  if ($found) {
    warn "That template is already checked out by $$found{whocheckedout}, " .
      "who checked it out at $$found{checkedout}.";
    return undef;
  } else {
    return $mod->new($data);
  }
}

sub checkin {
  my $mod = shift;
  $mod->{checkedin} = DemogTrak::now;
  $mod->{whocheckedin} = $Channel::user;
  return $mod->put;
}

1;