# $Id: Proposal.pm,v 1.26 2004/11/12 05:44:36 gwolf Exp $
######################################
# Comas - Conference Management System
######################################
# Copyright 2003 CONSOL
# Congreso Nacional de Software Libre (http://www.consol.org.mx/)
#   Gunnar Wolf <gwolf@gwolf.cx>
#   Manuel Rabade <mig@mig-29.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
######################################

######################################
# Module: Comas::Proposal
# Handles the interaction with a proposal for Comas
######################################
# Depends on:
#
# Comas::Common - Common functions for various Comas modules
# Comas::File - Manages the proposals' files
package Comas::Proposal;

use strict;
use warnings;
use Carp;
use Comas::Common qw(valid_hash);
use Comas::File;

=head1 NAME

Comas::Proposal - Handles the interaction with a proposal for Comas

=head1 SYNOPSIS

=head2 OBJECT CONSTRUCTOR

    $prop = Comas::Proposal->new(-db=>$db,
                                 -id=>$number);

or

    $prop = Comas::Proposal->new(-db=>$db,
                                 -title=>$title,
                                 -abstract=>$abstract,
                                 -prop_type_id=>$prop_type_id,
                                 -track_id=>$track_id,
                                 (...));

The constructor must receive a Comas::DB object in the C<-db> attribute.

The presence of the C<-id> attribute in the constructor implies that no other
descriptor attribute will be supplied - if C<new> is called with both kinds of
attributes, it will fail.

The attributes accepted by the constructor are (check Comas' database
documentation for further information) C<-id>, C<-title>, C<-abstract>,
C<-track_id>, C<-prop_status_id>, C<-prop_type_id>, C<-comments> and
C<-timeslot_id>.

=head2 LOOKUP FUNCTIONS

    @ids = Comas::Proposal->search(-db=>$db,
                                   -attr1=>$value1,
                                   -attr1=>$value2,
                                   (...));
    @ids = $p->search(-attr1=>$value1,
                      -attr2=>$value2,
                      (...));

Will return in C<@ids> the IDs of the proposals who match the given criteria.
Of course, if no proposal is found matching the criteria, an empty list will 
be returned. All the attributes valid for the constructor are valid.

You can use search either as a regular function (A.K.A. a class method) or as a
method (A.K.A. an instance method). Note that C<-db>, a Comas::DB object, is 
mandatory if you call it as a function, not if you call it as a method. 

Note that this will do a B<very> simple search - The matches must be exact
(i.e. there is no way of telling C<search> to search for regular expressions or
even comparisons (less than, greater than, etc). If you need that functionality,
you should implement it via Comas::DB.

    $days = Comas::Proposal->days_left_for_submission(-db=>$db);
    $days = $p->days_left_for_submission;

Will return the number of days left for an author to submit a proposal, as
defined in the configuration field C<proposals_new_max_date>. If the period is
over, it will return a negative number, showing the elapsed days since the 
period finished.

Please note that this checks only the B<number of days left>, not the exact 
time, i.e., if the submission period ends today, C<days_left_for_submission> 
will return 0 regardless if it ended at 00:00 or at 23:59. See
C<in_submission_period> for checking if submissions are still accepted at this
time.

    $ok = Comas::Proposal->in_submission_period(-db=>$db);
    $ok = $p->in_submission_period;

Returns 1 if the current time is before C<proposals_new_max_date>, this means,
if new proposals are still accepted in the system. Returns 0 if the submission
period is over.

=head2 ATTRIBUTE ACCESSORS AND MUTATORS

In order to access the proposal's attributes, you can use:

    $id = $prop->get_id;
    $title = $prop->get_title;
    $abstract = $prop->get_abstract;
    $track_id = $prop->get_track_id;
    $prop_status_id = $prop->get_prop_status_id;
    $prop_type_id = $prop->get_prop_type_id;
    $comments = $prop->get_comments;
    $timeslot_id = $prop->get_timeslot_id;

If you want to get all the attributes for a given proposal in a single hash 
(and in a single operation), you can use:

    %data = $prop->get_data;

And if you want to modify the current value for any of the attributes:

    $ok = $prop->set_title($title);
    $ok = $prop->set_abstract($abstract);
    $ok = $prop->set_track_id($track_id);
    $ok = $prop->set_prop_type_id($prop_type_id);

If you want to change more than one attributes for a given proposal, you can use:

    $ok = $person->set_data(-db=>$db,
                            -attr1=>$value1,
                            -attr2=>$value2, 
                            (...));

Note that no C<$prop-E<gt>set_prop_status_id> or C<$prop-E<gt>set_comments>
methods are provided or you can't use the C<-prop_status_id> or C<-comments>
keys in C<$proposal-E<gt>set_data>. In order to modify those attributes, use
L<Comas::Admin::academic_committee>.

=head2 MANAGING AUTHORS

In order to register a person as the author for this proposal, use the
add_author method:

    $ok = $prop->add_author($person_id);
    $ok = $prop->add_author($person_id, $mention_order);

If it is called with one argument only, it will add the given person_id as an 
author to the current proposal with the next available mention_order (i.e., the
highest registered mention_order plus 1 - It does not fill blank spaces left
by you). If it is called with two arguments, the person will be added as an
author with the specified priority if it is still available, and if it is not
available will fail, returning undef.

To remove a person from the list of authors of the proposal, use del_author:

    $ok = $prop->del_author($person_id);

It will return success either if the person was registered as an author of this
proposal and was successfully removed or if the person was not registered for
the proposal, and will fail only if the person could not be removed for some
reason.

In order to change the order on which the authors are listed for a given 
proposal, use move_author:

    $ok = $prop->move_author($person_id, $new_mention_order);

If someone else was already registered for this mention order, he will be
pushed one place down and the specified person will be inserted in this
place.

It will succeed only if the author was successfully moved - if the author 
could not be moved or was not registered for this proposal it will return
undef.

Finally, in order to get the list of authors for a given proposal:

    @authors = $prop->get_authors;
    %authors = $prop->get_authors(-result=>'hash');

If no arguments are given in the function call, it will return an array with
the authors' IDs, ordered by their mention_order. If -result=>'hash' is
specified, we will get a hash having the author IDs as the keys and the 
mention_order as the values. 

This might be useful because the mention_order, althought it is guaranteed to be
unique (i.e., no two authors will be listed in the same place), is not 
guaranteed to be compact - We could have an author with mention_order=15 and 
another one with mention_order=4500, and they would be listed in the first and 
second place. If the specific mention_order is important, then result=>'hash'
should be specified.

=head2 MANAGING FILES

    @ids = $prop->get_file_ids;
    @files = $prop->get_files;

Returns the files associated to this proposal. C<get_file_ids> will return
the list of file IDs, C<get_files> will create the C<Comas::File> objects for
each of them.

    $id = $prop->new_file(-filename => $file,
			  -descr => $descr,
			  -data => $data);

Please note that this will create the file, but will B<not> create the object
in memory (in order to save time and memory, as it will usually not be required
right away), will just return the new file's ID.

    $ok = $prop->delete_file($id);

=head2 CLASS METHODS

If you want to see the last error of the Comas::Person module, you could use:

    $err = Comas::Person->lastError;

And it will return a numeric code of the last error. The list of error codes is:

=over

=item General Error Codes:

 0 - Unknow Error
 1 - Wrong number of parameters
 2 - Mandatory '-db' field not specified or wrong
 3 - Invalid Keys recived
 4 - Missing or more information
 5 - Cannot search for an empty string
 6 - Invocation Error
 7 - Cannot insert empty value

=item Database Error Codes:

 101 - Could not prepare query
 102 - Could not execute query
 103 - Could not perform query

=item Proposal.pm Error Codes:

 200 - Internal Error.
 201 - '-id' given, no other attributes accepted
 202 - Could not find requested proposal
 203 - Too late for new proposal
 204 - More than one proposal matched
 205 - Could not query for the new proposal' id
 206 - Could not update an accepted proposal
 207 - Could not delete an accepted proposal

=item Proposal.pm authors Error Codes:

 300 - Could not query for next available author mention order
 301 - Could not place an author in the same place that other author
 302 - The author have too many proposals
 303 - The proposal have too many authors
 304 - Person was not registered as an author
 305 - Could not edit the authors of an accepted proposal

=back

=head1 REQUIRES

L<Comas::DB|Comas::DB>

L<Comas::Common|Comas::Common>

=head1 SEE ALSO

Comas' database documentation, http://wiki.consol.org.mx/comas_wiki/

=head1 AUTHOR

Gunnar Wolf, gwolf@gwolf.cx

Manuel Rabade, mig@mig-29.net

Comas has been developed for CONSOL, Congreso Nacional de Software Libre,
http://www.consol.org.mx/

=head1 COPYRIGHT

Copyright 2003 Gunnar Wolf and Manuel Rabade

This library is free software, you can redistribute it and/or modify it
under the terms of the GPL version 2 or later.

=cut

#################################################################
# Managing files

sub get_file_ids {
    my ($p, @files);
    $p = shift;

    @files = Comas::File->search(-db=>$p->{-db}, 
				 -proposal_id=>$p->{-id});

    return @files;
}

sub get_files {
    my ($p, @files);
    $p = shift;

    @files = map {Comas::File->new(-db => $p->{-db},
				   -id => $_)} $p->get_file_ids;

    return @files;
}

sub new_file {
    my ($p, $file);
    $p = shift;

    $file = Comas::File->new(-db => $p->{-db}, -proposal_id => $p->{-id}, @_);

    return $file->get_id;
}

sub delete_file {
    my ($p, $id, $file);
    $p = shift;
    $id = shift;

    unless (grep {$id == $_} $p->get_file_ids) {
	carp 'Tried to delete non-matching file - proposal '. $p->{-id} .
	    ', file ' . $id;
	return undef;
    }

    $file = Comas::File->new(-db => $p->{-db}, -id => $id);
    return $file->delete;
}

#################################################################
# Class Metods

my $lastError;

sub lastError {
    return $lastError;
}

sub setLastError {
    $lastError = shift;
}

#################################################################
# Object constructor

sub new {
    my ($class, $p);
    $class = shift;

    $p = { valid_hash(@_) };
    return undef unless (scalar keys %$p);

    if (ref($p->{-db}) ne 'Comas::DB') {
        setLastError(2);
	carp "Invocation error - mandatory '-db' field not specified or wrong";
	return undef;
    }

    if (defined $p->{-id}) {
	my ($sth, $r);

	if (scalar keys %$p > 2) {
            setLastError(201);
	    carp "Invocation error - '-id' given, no other attributes accepted";
	    return undef;
	}

	unless ($sth = $p->{-db}->prepare('SELECT title,
	abstract,track_id,prop_status_id, prop_type_id, comments,
	timeslot_id FROM proposal WHERE id = ? AND id != 0')) {
            setLastError(101);
	    carp 'Could not prepare proposal query: ', $p->{-db}->lastMsg;
	    return undef;
	}
	if ($sth->execute($p->{-id}) eq '0E0') {
            setLastError(202);
	    carp 'Could not find requested proposal';
	    return undef;
	}
        unless($sth->execute($p->{-id})) {
            setLastError(102);
            carp 'Could not execute proposal query: ', $p->{-db}->lastMsg;
            return undef;
        }

	$r = $sth->fetchrow_hashref;
	map {$p->{"-$_"} = $r->{$_}} keys %$r;

    } elsif (my @proposal = Comas::Proposal->search(%$p)) {
	# There is at least one proposal matching the set of data we are looking
	# for. If it is only one proposal, go ahead and create the object. If we 
	# get more than one proposal, complain and return undef.
	if (scalar @proposal > 1) {
            setLastError(204);
	    carp 'More than one proposal matched - Cannot continue.';
	    return undef;
	} elsif ( ! defined(Comas::Proposal->search(%$p))) {
            return undef;
        } else {
            $p = Comas::Proposal->new(-db=>$p->{-db}, -id=>$proposal[0]);
        }

    } else {
	# We received the list of values to insert and found no matching value 
	# in the database - Check the values are valid, create the new record,
	# retreive the ID and create the new Comas::Proposal object
	my ($sql, @keys, @values, $sth, $id, $ck);

	$ck = _ck_valid_keys($p);
	if  (not $ck) {
            setLastError(3);
	    carp 'Invalid keys received for proposal creation';
	    return undef;
	}
	if (not $ck & 2) {
            setLastError(4);
	    carp 'Cannot create proposal - missing information';
	    return undef;
	}
	$sql = 'INSERT INTO proposal (';

	# We store the ordered attributes in the arrays @keys and @values
	foreach my $k (keys %$p) {
	    next if $k eq '-db';
            my $value = join(' ', grep({$_;} split(/ /, $p->{$k}, 0)));
            if ($value eq '') {
                setLastError(7);
                carp 'Cannot insert empty value at key ', $k;
                return undef;
            }
	    push(@values, $p->{$k});
	    $k =~ s/^-//;
	    push(@keys, $k);
	}

	$sql .= join(', ', @keys);
	$sql .= ') VALUES (' . join(', ', map {'?'} @keys) . ')';

	# We now have a nice SQL insert statement with placeholders
	# and everything. Now do the dirty job...

	$p->{-db}->begin_work;
	unless ($sth = $p->{-db}->prepare($sql)) {
            setLastError(101);
	    carp 'Could not prepare proposal creation query: ', 
	    $p->{-db}->lastMsg;
	    $p->{-db}->rollback;
	    return undef;
	}

	unless ($sth->execute(@values)) {
            if (index($p->{-db}->lastMsg, 'sql_pnmd_ETOO_LATE_FOR_NEW_PROPOSAL')
                != -1) {
                setLastError(203);
            } else {
                setLastError(102);
            }                
	    carp "Could not execute proposal creation query: ",
	    $p->{-db}->lastMsg;
	    $p->{-db}->rollback;
	    return undef;
	}

	# The entry was created successfully! Now retrieve the new proposal ID
	# and return the new object.
	unless ($sth = $p->{-db}->prepare("SELECT currval('proposal_id_seq')")
                and $sth->execute and ($id) = $sth->fetchrow_array) {
            setLastError(205);
	    carp "Could not query for the new proposal' ID: ", 
	    $p->{-db}->lastMsg;
	    $p->{-db}->rollback;
	    return undef;
	}
	$p->{-db}->commit;
	$p = Comas::Proposal->new(-db=>$p->{-db}, -id=>$id);
    }

    bless ($p, $class);
    return $p;
}

##########################################################################
# Lookup functions

sub search {
    # Returns the list of proposals which conform to a given criteria
    # Receives a Comas::DB object as its first parameter, and a list of
    # key-value pairs for the following parameters.
    my ($p, $db, $sql, $sth, @attr, %vals);
    $p = shift;
    @attr = ();
    
    return undef unless @_;
    if (scalar @_ % 2) {
        setLastError(1);
	carp 'Invocation error - Wrong number of parameters', join('-',@_);
	return undef;
    }

    $db = $p->{-db} if ref $p;

    while (@_) {
	my $key = shift;
	$key =~ s/^-//;
	my $value = shift;

	if ($key eq 'db') {
	    $db = $value;
	    next;
	}
        $value = join(' ', grep({$_;} split(/ /, $value, 0)));

        if ($value =~ /^\s*$/) {
            setLastError(5);
            carp 'Cannot search for an empty value for key: ', $key;
            return undef;
        }

	push(@attr, $key);
	$vals{$key} = $value;
    }

    unless (ref($db)) {
        setLastError(2);
	carp 'No valid database handler received:';
	return undef;
    }

    # If we got no attributes, we are searching for a list of all proposals
    if (scalar @attr) {
	# We are performing a search on specific attributes
	unless (_ck_valid_keys(\%vals)) {
            setLastError(3);
	    carp 'Invalid keys received';
	    return undef;
	}

	$sql = 'SELECT id FROM proposal WHERE ' . 
	    join (' AND ', map {"$_ = ?"} @attr);
        $sql .= ' AND id != 0';
    } else {
	# We just want the list of all proposals
	$sql = 'SELECT id FROM proposal WHERE id != 0';
    }
    unless ($sth = $db->prepare($sql)) {
        setLastError(101);
	carp 'Could not prepare query: ', $db->lastMsg;
	return undef;
    }

    my $_sth = $sth->execute(map {$vals{$_}} @attr);

    unless ($_sth) {
        setLastError(102);
	carp 'Could not execute query: ', $db->lastMsg;
	return undef;
    }
        return map {$_->[0]} @{$sth->fetchall_arrayref};
}

sub days_left_for_submission {
    my ($p, $db, $sth);
    $p = shift;

    if (ref $p) {
	$db = $p->{-db};
    } elsif ($p eq '-db' or shift eq '-db') {
	$db = shift;
    } else {
	carp 'Invocation error';
	return undef;
    }

    unless ($sth = $db->prepare('SELECT days_for_new_proposals()') and 
	    $sth->execute) {
	carp 'Could not execute query: ', $db->lastMsg;
	return undef;
    }

    return $sth->fetchrow_array;
}

sub in_submission_period {
    my ($p, $db, $sth, $max_date);
    $p = shift;

    if (ref $p) {
	$db = $p->{-db};
    } elsif ($p eq '-db' or shift eq '-db') {
	$db = shift;
    } else {
	carp 'Invocation error';
	return undef;
    }

    unless ($max_date = $db->get_conf('proposals_new_max_date')) {
	carp 'Error looking up maximum acceptance date';
	return undef;
    }

    unless ($sth = $db->prepare('SELECT now() < ?') and
	    $sth->execute($max_date)) {
	carp 'Could not execute query: ', $db->lastMsg;
	return undef;
    }

    return $sth->fetchrow_array;
}

#################################################################
# Attribute accessors

sub get_id { my $p=shift; return $p->_get_attr('id'); }
sub get_title { my $p=shift; return $p->_get_attr('title'); }
sub get_abstract { my $p=shift; return $p->_get_attr('abstract'); }
sub get_track_id { my $p=shift; return $p->_get_attr('track_id'); }
sub get_prop_status_id { my $p=shift; return $p->_get_attr('prop_status_id'); }
sub get_prop_type_id { my $p=shift; return $p->_get_attr('prop_type_id'); }
sub get_comments { my $p=shift; return $p->_get_attr('comments'); }
sub get_timeslot_id { my $p=shift; return $p->_get_attr('timeslot_id'); }

sub get_data {
    my ($p, $sth, %ret);
    $p = shift;

    $sth = $p->{-db}->prepare('SELECT id, title,
	abstract, track_id, prop_status_id, prop_type_id, comments,
	timeslot_id FROM proposal WHERE id = ?') or return undef;
    $sth->execute($p->{-id}) or return undef;

    # Retreive the values and prepend the keys with our beloved dash before
    # returning them
    
    %ret = %{$sth->fetchrow_hashref};
    return map { my $tmp="-$_"; $tmp => $ret{$_} } keys %ret;
}

###########################################################################
# Attribute mutators

sub set_title { my $p=shift; return $p->_set_attr('title',shift); }
sub set_abstract { my $p=shift; return $p->_set_attr('abstract',shift); }
sub set_track_id { my $p=shift; return $p->_set_attr('track_id',shift); }
sub set_prop_type_id { my $p=shift; return $p->_set_attr('prop_type_id',shift); }

sub set_data {
    my $p = shift;
    my (%update, $update, $sql, @keys, @values, $sth, $ck);
    
    if (%update = valid_hash(@_)) {
	$update = { %update };
    } else {
        setLastError(6);
	carp 'Invocation error - Wrong number of parameters';
	return undef;
    }
    
    $ck = _ck_valid_keys($update);
    if (not $ck) {
        setLastError(3);
        carp 'Invalid keys received for proposal update';
        return undef;
    }
    if (not $ck & 4) {
        setLastError(4);
        carp 'Cannot update proposal - missing or more information';
        return undef;
    }
    
    $sql = 'UPDATE proposal SET ';
    
    # We store the ordered attributes in the arrays @keys and @values
    foreach my $k (keys %$update) {
        if ($update->{$k} eq '') {
            push(@values, undef);
        } else {
            push(@values, $update->{$k});
        }
        $k =~ s/^-//;
        push(@keys, $k);
    }
    
    $sql .= join(', ', map { $_ . ' = ? '} @keys);
    $sql .= ' WHERE id = ' . $p->{-id};

    # We now have a nice SQL update statement with placeholders
    # and everything. Now do the dirty job...
    
    $p->{-db}->begin_work;
    unless ($sth = $p->{-db}->prepare($sql)) {
        setLastError(101);
        carp 'Could not prepare proposal update query: ', 
        $p->{-db}->lastMsg;
        $p->{-db}->rollback;
        return undef;
    }
    
    unless ($sth->execute(@values)) {
        if (index($p->{-db}->lastMsg, 'sql_lpba_ECANT_MODIFY_ACCEPTED_PROP')
            != -1) {
            setLastError(206);
        } else {
            setLastError(102);
        }                
        carp "Could not execute proposal update query: ",
        $p->{-db}->lastMsg;
        $p->{-db}->rollback;
        return undef;
    }
    $p->{-db}->commit;
    return 1;
}

###########################################################################
# Deleting a proposal.

sub delete {
    my $p = shift;
    my ($sth, $sth_2);
    $p->{-db}->begin_work;
    # If there are any files associated to the proposal, delete them first
    unless ($sth = $p->{-db}->prepare('DELETE FROM prop_material WHERE 
            proposal_id = ?')) {
	setLastError(101);
	carp 'Could not prepare proposal material delete query',
	$p->{-db}->lastMsg;
	$p->{-db}->rollback;
	return undef;
    }
    unless ($sth->execute($p->{-id})) {
	setLastError(102);
	carp 'Could not execute proposal material delete query',
	$p->{-db}->lastMsg;
	$p->{-db}->rollback;
	return undef;
    }
    unless ($sth = $p->{-db}->prepare('DELETE FROM authors WHERE
            proposal_id = ?')) {
        setLastError(101);
        carp 'Could not prepare authors delete query: ', 
        $p->{-db}->lastMsg;
        $p->{-db}->rollback;
        return undef;
    }   
    unless ($sth->execute($p->{-id})) {
        if (index($p->{-db}->lastMsg,
                  'sql_laba_ECANT_MODIFY_ACCEPTED_AUTHORS') != -1 ||
            index($p->{-db}->lastMsg,
                  'sql_lpba_ECANT_MODIFY_ACCEPTED_PROP') != -1) {
            setLastError(207);
        } else {
            setLastError(102);
        }
        carp "Could not execute authors delete query: ",
        $p->{-db}->lastMsg;
        $p->{-db}->rollback;
        return undef;
    }
    unless ($sth_2 = $p->{-db}->prepare('DELETE FROM proposal WHERE id = ?')) {
        setLastError(101);
        carp 'Could not prepare proposal delete query: ', 
        $p->{-db}->lastMsg;
        $p->{-db}->rollback;
        return undef;
    }
    unless ($sth_2->execute($p->{-id})) {
        if (index($p->{-db}->lastMsg,
                  'sql_laba_ECANT_MODIFY_ACCEPTED_PROP') != -1) {
            setLastError(207);
        } else {
            setLastError(102);
        }                
        carp "Could not execute proposal delete query: ",
        $p->{-db}->lastMsg;
        $p->{-db}->rollback;
        return undef;
    }
    $p->{-db}->commit;
    return 1;
}

###########################################################################
# Authors functions

sub add_author {
    my ($sth, $p, $auth, $ment_order);
    $p = shift;
    $auth = shift;
    $ment_order = shift;

    if (grep { $_ == $auth} $p->get_authors) {
	# Is the author already registered for this proposal?
	if (defined $ment_order) {
	    # Did the user give us a specific mention order?
	    # If so, move the author to this place. Return the result of this
	    # operation.
	    return $p->move_author($auth, $ment_order);
	} 
	# If the user does not care about the mention order, just return
	# success - The author is registered for this proposal already.
	return 1;
    }

    unless (defined $ment_order) {
	# We must ask the DB for the next available mention_order
	unless ($sth = $p->{-db}->prepare('SELECT next_author_mention_order(?)')
		and $sth->execute($p->{-id})) {
            setLastError(300);
	    carp 'Could not query for next available author mention order';
	    return undef;
	}
	($ment_order) = $sth->fetchrow_array;
    }

    unless ($sth = $p->{-db}->prepare('INSERT INTO authors (proposal_id, 
            person_id, mention_order) VALUES (?, ?, ?)') and
	    $sth->execute($p->{-id}, $auth, $ment_order)) {
        if (index($p->{-db}->lastMsg, 'sql_naao_EORDER') != -1) {
            setLastError(301);
        } elsif (index($p->{-db}->lastMsg, 'sql_mpxp_ETOO_MANY_PROPOSALS')
                 != -1) {
            setLastError(302);
        } elsif (index($p->{-db}->lastMsg, 'sql_maxp_ETOO_MANY_AUTHORS') != -1) {
            setLastError(303);
        } elsif (index($p->{-db}->lastMsg,
                       'sql_laba_ECANT_MODIFY_ACCEPTED_AUTHORS') != -1) {
            setLastError(305);
        } else {
            setLastError(103);
        }
	carp 'Could not insert author: ', $p->{-db}->lastMsg;
	return undef;
    }

    return 1;
}

sub del_author {
    my ($sql, $sth);
    my $p = shift;
    my $author = shift;

    unless ($sth = $p->{-db}->prepare('DELETE FROM authors WHERE
	person_id = ? AND proposal_id = ?')) {
        setLastError(101);
	carp 'Could not prepare query: ', $p->{-db}->lastMsg;
	return undef;
    }
    
    unless ($sth->execute($author,$p->{-id})) {
        if (index($p->{-db}->lastMsg,
                  'sql_laba_ECANT_MODIFY_ACCEPTED_AUTHORS') != -1) {
            setLastError(305);
        } else {
            setLastError(102);
        }
	carp 'Could not execute query: ', $p->{-db}->lastMsg;
	return undef;
    }
    return 1;
}

sub move_author {
    my ($sql, $sth, %a);
    my ($p, $author, $order) = (shift, shift, shift);

    unless (grep {$_ == $author} $p->get_authors) {
        setLastError(304);
	carp 'Person was not registered as an author';
	return undef;
    }

    unless ($sth=$p->{-db}->prepare('SELECT insert_place_author_order(?,?)')) {
        setLastError(101);
	carp 'Could not prepare query: ', $p->{-db}->lastMsg;
	return undef;
    }
    
    unless ($sth->execute($order,$p->{-id})) {
        if (index($p->{-db}->lastMsg,
                  'sql_laba_ECANT_MODIFY_ACCEPTED_AUTHORS') != -1) {
            setLastError(305);
        } else {   
            setLastError(102);
        }
	carp 'Could not execute query: ', $p->{-db}->lastMsg;
	return undef;
    }

    unless ($sth = $p->{-db}->prepare('UPDATE authors SET
    mention_order=? WHERE proposal_id=? AND person_id=?')) {
        setLastError(101);
	carp 'Could not prepare query: ', $p->{-db}->lastMsg;
	return undef;
    }
    
    unless ($sth->execute($order,$p->{-id},$author)) {
        if (index($p->{-db}->lastMsg,
                  'sql_laba_ECANT_MODIFY_ACCEPTED_AUTHORS') != -1) {
            setLastError(305);
        } else {
            setLastError(102);
        }
	carp 'Could not execute query: ', $p->{-db}->lastMsg;
	return undef;
    }

    return 1;

}

sub get_authors {
    my ($sql, $sth, $p, $authors, $mode);
    $p = shift;
    $mode = 0;

    if (@_) {
	unless ($_[0] eq '-result') {
            setLastError(6);
            carp 'Invocation error';
            return undef;
        }
	$mode = 1 if $_[1] eq 'hash';
    }

    unless ($sth = $p->{-db}->prepare('SELECT person_id, mention_order
	FROM authors WHERE proposal_id=? ORDER BY mention_order')) {
        setLastError(101);
	carp 'Could not prepare query: ', $p->{-db}->lastMsg;
	return undef;
    }
    
    unless ($sth->execute($p->{-id})) {
        setLastError(102);
	carp 'Could not execute query: ', $p->{-db}->lastMsg;
	return undef;
    }

    $authors = $sth->fetchall_hashref('person_id');
    return $mode ?
	map { $_=>$authors->{$_}->{'mention_order'} } keys %$authors :
	sort {$authors->{$a}->{mention_order} <=> 
		  $authors->{$b}->{mention_order}} keys %$authors;

}

###########################################################################
# Internal functions, not for human consumption

sub _get_attr {
    # Called by attribute accessors. Gets as its only parameter the 
    # name of the attribute to fetch from the database.
    my ($p, $attr, $sth, $res);
    $p = shift;
    $attr = shift;

    # If the user is searching for the ID, we don't have to query the DB...
    return $p->{-id} if $attr eq 'id';

    $sth = $p->{-db}->prepare("SELECT $attr FROM proposal WHERE id = ?");
    $sth->execute($p->{-id});

    return $sth->fetchrow_array;
}

sub _set_attr {
    # Called by attribute mutators. Gets as its first parameter the
    # name of the attribute to modify and as its second parameter the value
    # to store.
    my ($p, $attr, $val, $sth, $res);
    $p = shift;
    $attr = shift;
    $val = shift;

    $sth = $p->{-db}->prepare("UPDATE proposal SET $attr = ? WHERE id = ?");
    unless($res = $sth->execute($val, $p->{-id})) {
        if (index($p->{-db}->lastMsg,
                  'sql_lpba_ECANT_MODIFY_ACCEPTED_PROP') != -1) {
            setLastError(206);
        } else {
            setLastError(102);
        }
    }
    return $res;
}

sub _ck_valid_keys {
    # Checks if all the keys of the hash reference received as the first
    # parameter are valid for their use in the database structure.
    #
    # Returns 0 if any extraneous key is received.
    # If all keys are valid, returns a value resulting from the bitwise addition
    # of what can be done with this set - Valid (1), insert (2), update (4),
    # use as full information (8)

    my (%hash, %valid, @ins, @upd, @rdonly, $ret);
    %hash = map { s/^-//; $_ => 1 } keys %{ $_[0]};

    # All the valid keys
    %valid = (id => 1, title => 1, abstract => 1, track_id => 1,
              prop_status_id => 1, prop_type_id => 1, comments => 1,
	      timeslot_id => 1);

    # Read only keys (i.e. can't be in a insert or update)
    @rdonly = qw(prop_status_id comments timeslot_id);

    # Keys required for insertion, update
    @ins  = qw(title abstract prop_type_id);
    @upd = qw();

    # We start assuming that the hash is insertable, updateable and complete.
    $ret = 15; # 15 = 8 | 4 | 2 | 1
    foreach my $k (keys %hash) {
	next if ($k eq 'db');
	# Invalid key? Return immediately, it cannot be used for anything.
	return 0 unless $valid{$k};
    }
    foreach my $key (@ins) {
	$ret &= ~2 unless exists $hash{$key};
    }
    foreach my $key (@upd) {
	$ret &= ~4 unless exists $hash{$key};
    }
    foreach my $key (@rdonly) {
	$ret &= ~6 if (exists $hash{$key});
    }

    # Now check if full, first remove from valid all the read-only
    # keys
    foreach my $key (keys %valid) {
        foreach my $rdonly_key (@rdonly) {
            delete $valid{$key} if ($key eq $rdonly_key)
        }
    }
    # Test the modified hash against the values
    foreach my $key (keys %valid) {
	$ret &= ~8 unless exists $hash{$key};
    }
    
    return $ret;
}

1;

# $Log: Proposal.pm,v $
# Revision 1.26  2004/11/12 05:44:36  gwolf
# Added the functionality to be able to handle more than one file per proposal and store it in the DB, not in separate files.
#
# Revision 1.25  2004/06/24 23:04:40  gwolf
# When displaying the attendee's menu, the option to submit a new
# proposal is only shown if they can still be received (this means,
# before the submission period is over).
#
# I am still missing a little bit here: It should also be hidden if the
# person has the maximum number of proposals registered.
#
# Revision 1.24  2004/04/13 05:13:12  gwolf
# A little efficiency hack
#
# Revision 1.23  2004/01/23 07:45:54  mig
# - La propuesta con id = 0 es utilitaria y no se despliega por ningun lado,
#   algo sucio :-/
#
# Revision 1.22  2003/12/24 07:29:31  mig
# - get_data tambien regresa '-id' en el hash
#
# Revision 1.21  2003/12/20 04:14:51  mig
# - Agrego tags Id y Log que expanda el CVS
#
