#!/usr/bin/perl


## W3C W3C::Registration::RdfReg - W3C PERL Library

#Copyright Massachusetts Institute of technology, 1998.
#Written by Eric Prud'hommeaux
#Last revision, $Date: 2000/02/16 18:09:04 $

#things that need to be done:
#1. decide whether to use RESOURCE, KEYS

package W3C::Registration::RdfReg;
use W3C::Database::DBIInterface;
@W3C::Registration::RdfReg::ISA = ("W3C::Database::DBIInterface");

use strict;

require 5.000;

$W3C::Registration::RdfReg::revision = '$Id: RdfReg.pm,v 1.1 2000/02/16 18:09:04 eric Exp $ ';
$W3C::Registration::RdfReg::VERSION = 0.14;

use Carp;

#####
# CONSTANTS

*STATE_FIRST		= \1;
*STATE_RENDER_USER	= \1;
*STATE_SELECTED_USER	= \2;
*STATE_FORM_INPUT	= \3;
# *STATE_FORM_REVISE      = \4;
*STATE_FORM_DISPLAY	= \5;
*STATE_FORM_EDIT	= \6;
*STATE_FORM_PARSE	= \7;
*STATE_LAST		= \7;

*ACTION_REPLACE_MARKUP	= \1;
*ACTION_REPLACE_TABLE	= \2;

$W3C::Registration::RdfReg::DUMMY	= '_w3c_dummy';
$W3C::Registration::RdfReg::FORMSOURCE = '_w3c_formSource';

#####
# per-class data

my $Debugging = 0;	# whether to show debugging stuff

#####
# per-object data
# DEBUG		- per-object control of debugging info

#####
# new - prepare a W3C::Registration::RdfReg with a new connection

sub new {
    my ($proto, $fieldTable, $properties, $rdfDB) = @_;
    my $class = ref($proto) || $proto;
    my $self = $class->SUPER::new($properties, 0); # !!! must be 0 for real production
    $self->{FIELDTABLE} = $fieldTable;
    $self->{RDF_DB} = 0;
    $self->{DEBUG} = 0;
    bless ($self, $class);
    return $self;
}

#####
# addMeeting
# @@@ - unused

sub addMeeting {
    my $self = shift;
    my $name = shift;
    my $descrip = $self->escape(shift);
    my $start = $self->escape(shift);
    my $end = $self->escape(shift);
    my $cutoff = $self->escape(shift);
    my $blurb = $self->escape(shift);
    my $tail = $self->escape(shift);
    $self->executeUpdate('insert into tableList values (null, '.$self->escape($name).','.$descrip.','.$start.','.$end.','.$cutoff.','.$blurb.','.$tail.')');
    return $self->getMeetingId($name);
}

#####
# createMeeting

sub createMeeting {
    my $self = shift;
    my $name = shift;

    my $id = $self->getMeetingId($name);
    my $tableDesc='id int(10) unsigned PRIMARY KEY,';
    my (@name, @type, @req, @maxlength);
    $self->executeQuery(4,\@name,\@type,\@req,"select name,type,req from formFields where meeting=$id");
    ##### get the maxlength here by parsing the input html

    for (my $i=0;$i<=$#name;$i++) {
	$tableDesc .= ' '.$name[$i].' '.$self->getTypeName($type[$i],$maxlength[$i]);
	($req[$i] && ($tableDesc .= ' NOT NULL'));
	$tableDesc .= ',';
    }
    chop $tableDesc;
    $self->createTable($name,$tableDesc);
}

#####
# renameMeeting

sub renameMeeting {
    my $self = shift;
    my $from = shift;
    my $to = shift;
    return $self->executeUpdate('alter table '.$from.' rename '.$to);
}

#####
# deleteMeeting

sub deleteMeeting {
    my $self = shift;
    my $name = shift;
    return if (!defined $name || $name eq 'tableList' || $name eq 'users');
    my $dropTable = shift;
    my $id = undef;
    eval {
	$id = $self->getMeetingId($name);
	if (defined $id) {
	    eval {$self->executeUpdate('delete from tableList where id='.$id);};
	    eval {$self->executeUpdate('delete from formFields where meeting='.$id);};
	    eval {$self->dropTable($name);} if ($dropTable); # warn $@ if $@;
	}
    };
}

#####
# getMeetingId

sub getMeetingId {
    my $self = shift;
    my $name = $self->escape(shift);
    return $self->executeSingleQuery('select id from tableList where name='.$name);
#    my $name = shift;
#    my @id;
#    $self->executeQuery(1,\@id,"select id from tableList where name='$name'");
#    return $id[0];
}

#####
# getMeetingName

sub getMeetingName {
    my $self = shift;
    my $id = shift;
    return $self->executeSingleQuery('select name from tableList where id='.$id);
}

#####
# getMeetingInfo

sub getMeetingInfo {
    my $self = shift;
    my $id = shift;
    my (@descrip, @start, @end, @cutoff, @blurb, @endBlurb, @replyTo, @cc, @contact);
    $self->executeQuery(9, \@descrip, \@start, \@end, \@cutoff, \@blurb, \@endBlurb, \@replyTo, \@cc, \@contact, 
			"select descrip,start,end,cutoff,blurb,end_blurb,replyTo,cc,contact from tableList where id=$id");
    return ($descrip[0], $start[0], $end[0], $cutoff[0], $blurb[0], $endBlurb[0], $replyTo[0], $cc[0], $contact[0]);
}

#####
# getMeetingList

sub getMeetingList {
    my $self = shift;
    my ($ids, $name, $descrip, $start, $end, $cutoff, $blurb, $endBlurb) = @_;
    return $self->executeQuery(8, $ids, $name, $descrip, $start, $end, $cutoff, $blurb, $endBlurb, 
			       'select id,name,descrip,start,end,cutoff,blurb,end_blurb from tableList where type=\'M\' order by id');
}

#####
# getMeetingTable

sub getMeetingTable {
    my $self = shift;
    my $id = shift;
    my (@table);
    $self->executeQuery(1, \@table,"select name from tableList where id=$id");
    return $table[0];
}

#####
# showMeetingHeader

sub showMeetingHeader {
    my $self = shift;
    my $meetingId = shift;
    my ($descrip, $start, $end, $cutoff, $blurb, $endBlurb) = $self->getMeetingInfo($meetingId);
    my $dateRange = $self->dateRange($start, $end);
    my $cutoffW = $self->dateToStr($cutoff);

    print <<END_HEADER;
<center><h1>RdfReg for <i>$descrip</i>: 
<br>$dateRange</center></h1></center>
<center>$blurb</center><p>
<center>RdfReg ends $cutoffW.</center>
<p>
END_HEADER
    ;
}

sub dateRange {
    my $self = shift;
    my $start = shift;
    my $end = shift;
    my $ret = $self->dateToStr($start);
    $ret .= ' - '.$self->dateToStr($end) if (defined $end);
    return $ret;
}

#####
# getRegistrantList

sub getRegistrantList {
    my $self = shift;
    my $meetingName = shift;
    my $res = shift;
    my $orderBy = shift;
    $orderBy = 'users.last' if (!defined $orderBy);
    my @meetingColumns;
    $self->executeQuery(\@meetingColumns, 'select formFields.name from formFields,tableList where meeting=id and tableList.name='.$self->escape($meetingName).' and formFields.type!="_w3c_dummy"');
    my @queryColumns = ('users.given','users.family','users.email','users.org','users.phone','users.last');
    my (@arrays) = ([],[],[],[],[],[]);		# same number of entries as fields listed above
    foreach my $meetingColumn (@meetingColumns) {
	push (@arrays, []);
	push (@queryColumns, $meetingName.'.'.$meetingColumn);
    }
    my $query='select '.join(',', @queryColumns).' from '.$meetingName.',users where '.$meetingName.'.id=users.id order by '.$orderBy;
    $self->executeQuery(@arrays, $query); # @@@ echck out executeArrayQuery
    my $col1 = $arrays[0];
    for (my $rowNo = 0; $rowNo <= $#$col1; $rowNo++) {
	my @row;
	for (my $colNo = 0; $colNo <= $#queryColumns; $colNo++) {
	    $ {$$res[0]}[$colNo] = $queryColumns[$colNo] if ($rowNo == 0);
	    my $entry = $ {$arrays[$colNo]}[$rowNo];
	    $entry = $self->dateTimeToStr($entry), "<br>\n" if ($queryColumns[$colNo] eq 'users.last');
	    $ {$$res[$rowNo+1]}[$colNo] = $entry;
	    push (@row, $entry);
	}
    }
}

#####
# getUserList

sub getUserList {
    my $self = shift;
    my $id = shift;
    my $family = shift;
    my $given = shift;
    my $org = shift;
    $self->executeQuery(4, $id, $family, $given, $org,'select id,family,given,org from users order by family');
}

#####
# getUserName

sub getUserName {
    my $self = shift;
    my $id = shift;
    my (@given, @family);
    return undef if ($self->executeQuery(2, \@given, \@family,"select given,family from users where id=$id") == 0);
    return $given[0].' '.$family[0];
}

#####
# getUserIdFromEmail

sub getUserIdFromEmail {
    my $self = shift;
    my $email = $self->escape(shift);
    my @ret;
    $self->executeWideQuery(\@ret, 'select id,auth,last from users where email='.$email);
    return @ret if (!defined $ret[0]);
    my $newAuth = $self->updateOldAuth($ret[0],$ret[2]);
    $ret[1] = $newAuth if (defined $newAuth);
    return @ret;
}

#####
# getEmailFromUserId

sub getEmailFromUserId {
    my $self = shift;
    my $id = shift;

    my $st = "select email from users where id=$id";
    my @id = ();
    return ($self->executeQuery(1,\@id,$st)) ? $id[0]: 0;
}

#####
# checkUserAuthentication

sub checkUserAuthentication {
    my $self = shift;
    my $id = shift;
    my $auth = shift;
    my @data;
    $self->executeWideQuery(\@data, 'select auth,last from users where id='.$id);
#    $auth= crypt($auth, $auth[0]);
    return -1 if (defined $self->updateOldAuth(($id, $data[1])));

    return ($data[0] eq $auth);
}

sub updateOldAuth {
    my $self = shift;
    my $id = shift;
    my $last = shift;
    my @curGmtime = gmtime(time);
    my $expireGmtimeRef = $self->mysqltimeToGmtime($last);
    $expireGmtimeRef->[3] += 3; # an auth is good for three day
    if ($self->gmtimeCompare(\@curGmtime,$expireGmtimeRef)>0) {
	my $auth = $self->makeAuth;
	$self->executeUpdate('update users set auth='.$self->escape($auth).' where id='.$id);
	return $auth;
    }
    return undef;
}

#####
# assignUserId

sub assignUserId {
    my $self = shift;
    my $email = $self->escape(shift);
    my $auth = $self->makeAuth;
    $self->executeUpdate('insert into users (email,auth) values ('.$email.','.$self->escape($auth).')');
    my $id = $self->executeSingleQuery('select id from users where email='.$email);
    return ($id, $auth);
}

#####
# makeAuth

sub makeAuth {
# Gerald'd get_cookie function

# this is more verbose than it needs to be, but it seems that doing it all as
# one statement ("$value = time * 100000") causes overflows on some systems?
    my $self = shift;
    my $value = time;
    $value *= 100000;
    $value += $$;
    $value *= 100000;
    $value += rand( 100000 );
    my $ret = "";
    my $mod = 62;
    while ($value) {
        my $chunk = $value - ( int( $value / $mod ) * $mod );
        $ret .= pack( "c", 0x41 + $chunk );
        $value = int( $value / $mod );
    }
    $ret =~ tr/\[\\\]\^\_\`\{\|\}\~/0123456789/;        # ick
    return $ret;
}

#####
# getCodeForUser

#sub getCodeForUser {
#    my $self = shift;
#    return $self->executeSingleQuery('select auth from users where email='.$email);
#}

#####
# checkCutoff

sub checkCutoff {
    my ($self, $cutoff) = @_;
    
    # get the gmtime stucture for the cutoff
    my $cutoffGmtimeRef = $self->dateToGmtime($cutoff);

    # compare to midnight this morning
    my @curGmtime = gmtime(time);
    splice (@curGmtime, 0, 3, (0,0,0));

    return ($self->gmtimeCompare(\@curGmtime,$cutoffGmtimeRef) <= 0);
}

#####
# getFormIdFromName

sub getFormIdFromName {
    my $self = shift;
    my $name = $self->escape(shift);
    return $self->executeSingleQuery('select id from tableList where name='.$name);
#    my $st = "select id from tableList where name=$name";
#    my @id = ();
#    return ($self->executeQuery(1,\@id,$st)) ? $id[0]: 0;
}

#####
# assignFormId

sub assignFormId {
    my $self = shift;
    my @id;
    $self->executeQuery(1,\@id,'select max(id) from tableList');
    return ($id[0]+1);
}

#####
# addFormField

sub addFormField {
    my $self = shift;
    my $id = shift;
    my $seqNo = shift;
    my $type = $self->escape(shift);
    my $markup = $self->escape(shift);
    my $name = $self->escape(shift);
    my $input = $self->escape(shift);
    my $req = shift;
    my $fieldTable = 'formFields';
#    my $update = 'insert into '.$fieldTable.' (meeting,name,type,req,descrip,seqNo,markup,extra) values ('.$id.','.$name.','.$type.',"N",null,'.$seqNo.',';
    my $update = 'insert into '.$fieldTable.' (meeting,seqNo,type,markup,name,input,req) values ('.$id.','.$seqNo.','.$type.','.$markup.',';
    $update .= defined $name ? $name.',' : 'null,';
    $update .= defined $input ? $input.',' : 'null,';
    $update .= ($req ? '"Y"' : '"N"') . ')';
    $self->executeUpdate($update);
}

#####
# deleteFormFields

sub deleteFormFields {
    my $self = shift;
    my $id = shift;
    $self->executeUpdate('delete from formFields where meeting='.$id);
}

#####
# getFieldList

sub getFieldList {
    my $self = shift;
    my $fieldTable = $self->{FIELDTABLE};
    my $fieldId = shift;
#    my ($name, $type, $req, $descrip, $seqNo, $markup) = @_;
    my $names = shift;
    my $type = shift;
    my $req = shift;
    my $markup = shift;
    my $seqNo = shift;
    my $input = shift;
    $self->executeQuery(6, $names, $type, $req, $markup, $seqNo, $input,
			"select name,type,req,markup,seqNo,input from $fieldTable where meeting=$fieldId order by seqNo");
}

#####
# getSaveFieldList

sub getSaveFieldList {
    my $self = shift;
    my $fieldTable = $self->{FIELDTABLE};
    my $fieldId = shift;
    my $names = shift;
    my $type = shift;
    my $req = shift;
    my $markup = shift;
    my $seqNo = shift;
    my $input = shift;
    $self->executeQuery(6, $names, $type, $req, $markup, $seqNo, $input,
			"select name,type,req,markup,seqNo,input from $fieldTable where meeting=$fieldId and type<>\'$W3C::Registration::RdfReg::DUMMY\' order by seqNo");
}

#####
# removeDummy

sub removeDummy {
    my $self = shift;
    my $fields = shift;
    my $type = shift;

    my @newFields = ();
    foreach my $field (@$fields) {
	if ($$type{$field} ne $W3C::Registration::RdfReg::DUMMY && $$type{$field} ne $W3C::Registration::RdfReg::FORMSOURCE) {
	    push(@newFields,$field);
	}
    }

    return \@newFields;
}


#####
# getDBFieldData

sub getDBFieldData {
    my $self = shift;
    my $fields = shift;
    my $dataTable = shift;
    my $dataId = shift;
    my @ret;
    $self->executeWideQuery(\@ret, 'select '.join(',', @$fields).' from '.$dataTable.' where id='.$dataId);
    my %ret;
    foreach my $field (@$fields) {
	$ret{$field} = shift(@ret);
    }
    return \%ret;
}

#####
# setFieldData

sub setFieldData {
    my $self = shift;
    my $fields = shift;
    my $dataTable = shift;
    my $insertString = shift;
    my @ret;
    local $" = ',';
    return $self->executeUpdate('replace into '.$dataTable." (@$fields)".' values ('.$insertString.')');
}

#####
# getCGIFieldData

sub getCGIFieldData {
    my $self = shift;
    my $query = shift;
    my $fields = shift;
    my %ret;
    foreach my $field (@$fields) {
	$ret{$field} = $query->param($field);
    }
    return \%ret;
}

sub getTableInfo {
    my ($self, $id, $setA, $setB) = @_;
    $self->executeDerefedWideQuery($setA, 'select id,name,descrip,start,end,cutoff,blurb,tail,end_blurb,cc,contact,replyto,type from tableList where id='.$id);
    $self->executeQuery(@$setB, 'select name,type,req,markup,seqNo,input,extra from formFields where meeting='.$id.' order by seqNo');
}

sub getACList {
    my ($self) = @_;
    my @orgs;
    $self->executeQuery(\@orgs,'select name from ACList');
    return @orgs;
}

#####
# checkState

sub checkState {
    my $self = shift;
    my $state = shift;
    return $state >= $W3C::Registration::RdfReg::STATE_FIRST && $state <= $W3C::Registration::RdfReg::STATE_LAST;
}

#####
# readState

sub readState {
    my ($self, $query) = @_;
    my ($state, $meetingName, $meetingId, $userName, $userId);
    $state = $query->param('_w3c_state');
    $meetingId = $query->param('_w3c_meetingId');
    $meetingName = $query->param('_w3c_meetingName');
    $userId = $query->param('_w3c_userId');

    $state = $W3C::Registration::RdfReg::STATE_RENDER_USER if (!defined $state);
    eval { $meetingName = $self->getMeetingName($meetingId) if (!defined $meetingName && defined $meetingId); };
    eval { $meetingId = $self->getMeetingId($meetingName) if (!defined $meetingId && defined $meetingName); };
    $userName = $self->getUserName($userId) if (defined $userId);
    return ($state, $meetingName, $meetingId, $userName, $userId);
}

#####
# writeState

sub writeState {
    my $self = shift;
    my ($query, $state, $meetingId, $userId) = @_;
    my $ret;
    $ret .= $query->hidden(-name=>'_w3c_state',-value=>$state,-override=>1);
    $ret .= $query->hidden(-name=>'_w3c_meetingId',-value=>$meetingId,-override=>1);
    $ret .= $query->hidden(-name=>'_w3c_userId',-value=>$userId,-override=>1) if defined($userId);
    $ret .= $query->hidden(-name=>'_w3c_auth',-value=>$query->param('_w3c_auth'),-override=>1);
    my $nextMeetingId = $query->param('_w3c_nextMeetingId');
    my $nextMeetingName = $query->param('_w3c_nextMeetingName');
    $ret .= $query->hidden(-name=>'_w3c_nextMeetingId',-value=>$nextMeetingId,-override=>1) if (defined $nextMeetingId);
    $ret .= $query->hidden(-name=>'_w3c_nextMeetingName',-value=>$nextMeetingName,-override=>1) if (defined $nextMeetingName);
    return $ret;
}

#####
# setState

sub setState {
    my $self = shift;
    my ($query, $state, $meetingId, $userId) = @_;
    $query->param(-name=>'_w3c_state',-value=>$state);
    $query->param(-name=>'_w3c_meetingId',-value=>$meetingId);
    $query->param(-name=>'_w3c_userId',-value=>$userId);
}

#####
# nextState

sub nextState {
    my $self = shift;
    my $query = shift;
    my ($meetingName, $meetingId);
    $meetingName = $query->param('_w3c_nextMeetingName');
    $meetingId = $query->param('_w3c_nextMeetingId');
    eval { $meetingName = $self->getMeetingName($meetingId) if (!defined $meetingName && defined $meetingId); };
    eval { $meetingId = $self->getMeetingId($meetingName) if (!defined $meetingId && defined $meetingName); };

    return ($meetingName, $meetingId);
}

sub mailText {
    my $self = shift;
    my($toList, $fromList, $subject, $mesg) = @_;
#    my $cmd = "| /usr/lib/sendmail -f$replyTo $emailId,$cc,$replyTo >/dev/null 2>&1";
    my $to = join(',', @$toList);
    my $from = join(',', @$fromList);
#    print "<br>\n", $cmd, "<br>\n";
    unless (open(MAIL, "| /usr/lib/sendmail -t -f$from >/dev/null 2>&1")) {
	print "<P><B>ERROR: Couldn't open sendmail</b>\n";
	die("couldn't open pipe");
    }
    print MAIL 'To: ', $to, "\n";
    print MAIL 'From: ', $from, "\n";
    print MAIL 'Subject: ', $subject, "\n";
    print MAIL "Bcc: register-log\@w3.org\n";
    print MAIL "\n";
    print MAIL $mesg;
    close(MAIL);
}

sub listMeetings {
    my ($self, $query, $verbose) = @_;
    my (@ids, %name, %descrip, %start, %end, %cutoff, %blurb, %endBlurb);
    $self->getMeetingList(\@ids,\%name,\%descrip,\%start,\%end,\%cutoff,\%blurb,\%endBlurb);
    my $selfUrl = $query->url;
    my $orderBy = $query->param('_w3c_orderBy');
    $orderBy = '&_w3c_orderBy='.$orderBy if (defined $orderBy);
    my $orEdit = $verbose ? " or edit. Please see the <a href=\"http://www.w3.org/Web/HowTo/RegForm.html\">HowTo</a> for editing instructions." : ':';
    print <<END_HEADER;
<h1><center>Meeting list</center></h1>
Please select the meeting for which you wish to register$orEdit
<ul>
END_HEADER
    ;

    foreach my $id (@ids) {
#	next if ($id != 99);
	my ($startW, $endW, $cutoffW) = ($self->dateToStr($start{$id}), 
					 $self->dateToStr($end{$id}), 
					 $self->dateToStr($cutoff{$id}));
	my $line = "<em>$descrip{$id}</em> $startW - $endW";
	if ($self->checkCutoff($cutoff{$id})) {
	    my $idStr; $idStr = $id.' - ' if ($verbose);
	    print "  <li>$idStr<a href=\"$selfUrl?_w3c_meetingName=$name{$id}\">$line (cutoff:$cutoffW)</a>";
	} elsif ($verbose) {
	    print "  <li>$id - <font color=\"#ff0000\">$line (expired:$cutoffW)</font>";
	}
	if ($verbose) {
	    print " <a href=\"$selfUrl?_w3c_special=listRegistrants&_w3c_meetingName=$name{$id}$orderBy\">registrants</a>\n";
	    print " <a href=\"formEdit.pl?_w3c_state=6&_w3c_meetingId=1&_w3c_nextMeetingId=$id\">edit form</a>\n";
	}
    }
    print "<\ul>\n";
}

sub listRegistrants {
    my ($self, $query, $meetingName) = @_;
    my @res = ();
    $self->getRegistrantList($meetingName, \@res, $query->param('_w3c_orderBy'));
    my $selfUrl = $query->url;
    $selfUrl = &catQuery($query, $selfUrl, '_w3c_special');
    $selfUrl = &catQuery($query, $selfUrl, '_w3c_meetingName');
    print <<END_HEADER;
<h1><center>Registrant list</center></h1>
END_HEADER
    ;
    print "<table border=1><caption>There are <strong>$#res</strong> registrants.</caption>\n";
    my $line = shift @res;
    # column headings
    print "<tr><th>";
    for (my $colNo = 0; $colNo <= $#$line; $colNo++) {
	my $tweaked = $line->[$colNo];
	$tweaked =~ s/^users\.(.*)$/$1/;
	$tweaked =~ s/^.*?\.(.*)$/\<em\>$1\<\/em\>/;
	$tweaked =~ s/_/ /g;
	print '<a href="'.&catQuery($query, $selfUrl, '_w3c_orderBy', $line->[$colNo]).'">'.$tweaked.'</a>';
	print '</th><th>' if ($colNo < $#$line);
    }
    print "</th></tr>\n";
    # database data
    foreach my $line (@res) {
	print "<tr><td>";
	print join ('</td><td>', @$line);
	print "</td></tr>\n";
    }
    print "</table>\n";
}

sub catQuery {
    my ($query, $url, $lookFor, $var) = @_;
    $var = $query->param($lookFor) if (!defined $var);
    if (defined $var) {
	$url .= $url =~ /\?/ ? '&' : '?';
	$url .= $lookFor . '=' .$var;
    }
    return $url;
}

#####
# debug - cannonical debugging stuff from
# http://www.perl.com/CPAN-local/doc/manual/html/pod/perltoot/Debuging_Methods.html

sub debug {
    my $self = shift;
    confess "usage: thing->debug(level)"    unless @_ == 1;
    my $level = shift;
    if (ref($self))  {
	$self->{"_DEBUG"} = $level;
    } else {
	$Debugging = $level;            # whole class
    }
  $self->SUPER::debug($Debugging);
}

1;
