# $Id: Payment.pm,v 1.14 2004/02/06 21:51:31 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::Payment - Managing payments for Comas
#
######################################
# Depends on:
# 
# Comas::Proposal - Handles the interaction with a proposal for Comas
# Comas::Admin - Manage administrative tasks for a Comas database
package Comas::Payment;

use strict;
use warnings;
use Carp;
use Comas::Proposal;
use Comas::Admin;

=head1 NAME

Comas::Payment - Managing payments for Comas

=head1 SYNOPSIS

Unlike most other Comas modules, Comas::Payment does not work in a 
object-oriented way - As the actions that can be done regarding payments are
quite simple, this module presents a procedural interface.

As there is no Payment object, every call to a function in this module will
require a valid, active Comas::DB object passed as the '-db' parameter.

=head2 Regsitering and modifying payments

Any modification in the payment table must be done by a valid Comas 
administrator, so in order to register or modify a payment, we always need
to supply an administrator login and password.

  $payment_id = Comas::Payment->register(-db => $db, 
                                         -admin => $login, -admin_pwd => $pwd,
                                         -person => $person_id, 
                                         -amount => $amount,
                                         -payment_type => $payment_type_id,
                                         [-proposal => $proposal_id]);

A payment can be registered by giving the person ID, the amount paid and the
payment type (see Comas' databse documentation, 
L<http://wiki.consol.org.mx/comas_wiki/>, for further information). Optionally,
a proposal ID can be specified if the person is paying for.

The administrator who registers a payment must have the C<payment_reg> 
privilege (see L<Comas::Admin> for further details). 

  $ok = Comas::Payment->modify(-db => $db, -id => $payment_id, 
                               -admin => $login, -admin_pwd => $pwd,
                               [-person => $person_id],
                               [-proposal => $proposal_id],
                               [-amount => $amount],
                               [-payment_type => $payment_type_id]);

In order to modify a payment record, the payment ID must be specified. The ID
can be obtained by searching for the particular data with C<get_payments>.

  $ok = Comas::Payment->delete(-db=>$db, -id=>$payment_id);

Deletes (permanently) a payment from the database.

The administrator who modifies or deletes a payment must have the 
C<payment_mod> privilege (see L<Comas::Admin> for further details). 

=head2 Querying for information

  @payment_id = Comas::Payment->get_payments(-db => $db, 
                                             [-person => $person_id],
                                             [-amount => $amount], 
                                             [-min_amount => $amount], 
                                             [-max_amount => $amount], 
                                             [-payment_type=>$payment_type_id],
                                             [-admin_id => $admin_id],
                                             [-proposal_id => $proposal_id]
                                             [-timestamp => $timestamp]
                                             [-min_timestamp => $timestamp]
                                             [-max_timestamp => $timestamp]);

  ($person_id, $proposal_id, $amount, $admin_id, $payment_type_id,
   $timestamp) = Comas::Payment->get_payment_data(-db=>$db, -payment_id=>$id);

=head2 Related utilities

  $amount = Comas::Payment->calculate_amount(-db => $db, -person => $person_id,
                                             -proposals => [@proposals],
                                             [-date => $date]);

=head1 REQUIRES

Comas::Proposal - Handles the interaction with a proposal for Comas
Comas::Admin - Manage administrative tasks for a Comas database

=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, 2004 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

sub register {
    my (%par, $adm, $sth, $id);
    my $class = shift;
    %par = @_;

    for my $attr qw(db admin admin_pwd person amount payment_type) {
	unless (defined $par{"-$attr"}) {
	    carp "Required attribute $attr missing";
	    return undef;
	}
    }

    unless ($adm=Comas::Admin->new(-db=>$par{-db}, -login=>$par{-admin},
				   -passwd=>$par{-admin_pwd}) and
	    $adm->ck_admin_task(-task=>'payment_reg')) {
	carp 'Insufficient privileges for registering payments';
	return undef;
    }

    $par{-db}->begin_work;

    $par{-proposal} = 0 unless $par{-proposal};

    unless ($sth=$par{-db}->prepare('INSERT INTO payment (person_id, 
            amount, admin_id, payment_type_id, proposal_id) VALUES (?,?,?,?,?)')
	    and $sth->execute($par{-person}, $par{-amount}, $adm->get_id, 
			      $par{-payment_type}, $par{-proposal})) {
	carp 'Could not insert requested data';
	$par{-db}->rollback;
	return undef;
    }

    unless ($sth=$par{-db}->prepare("SELECT currval('payment_id_seq')") and
	    $sth->execute and ($id) = $sth->fetchrow_array) {
	carp 'Could not verify insertion of requested data';
	$par{-db}->rollback;
	return undef;
    }

    $par{-db}->commit;
    return $id;
}

sub modify {
    my (%par, $adm, $sth, @data, $attr);
    my $class = shift;
    %par = @_;

    for $attr qw(db id admin admin_pwd) {
	unless ($par{"-$attr"}) {
	    carp "Required attribute $attr missing";
	    return undef;
	}
    }

    unless ($adm=Comas::Admin->new(-db=>$par{-db}, -login=>$par{-admin},
				   -passwd=>$par{-admin_pwd}) and
	    $adm->ck_admin_task(-task=>'payment_mod')) {
	carp 'Insufficient privileges for registering payments';
	return undef;
    }

    for $attr (keys %par) {
	my $field = $attr;
	$field =~ s/^-//;
	next if grep {$field eq $_} qw(db id admin admin_pwd);

	if (! grep {$_ eq $field} qw(person proposal amount payment_type)) {
	    carp "Invocation error - Parameter $field unknown";
	    return undef;
	}

	push @data, [$field, $par{$attr}];
    }

    unless ($sth=$par{-db}->prepare('UPDATE payment SET ' .
				    join(', ', map {"$_->[0] = ?"} @data) .
				    'WHERE id = ?') and 
	    $sth->execute(map({$_->[1]} @data), $par{-id})) {
	carp 'Unable to execute requested modification';
	return undef;
    }

    return 1;
}

sub delete {
    my (%par, $adm, $sth, $id);
    my $class = shift;
    %par = @_;

    if (!defined $par{-db} or !defined $par{-id} or 
	scalar(keys %par) != 2) {
	carp 'Invocation error';
	return undef;
    }

    unless ($sth = $par{-db}->prepare('DELETE FROM payment WHERE id = ?') and
	    $sth->execute($par{-id})) {
	carp 'Unable to remove specified payment';
	return undef;
    }

    return 1;
}

sub get_payments {
    my (%par, @data, $sth);
    my $class = shift;
    %par = @_;

    if (!defined $par{-db}) {
	carp 'Required parameter -db missing';
	return undef;
    }

    for my $par (keys %par) {
	if (! grep {$par eq "-$_"} qw(person amount min_amount max_amount
				      payment_type admin_id proposal_id
				      timestamp max_timestamp min_timestamp db)) {
	    carp "Invocation error - Parameter $par unknown";
	    return undef;
	}
    }

    if (defined $par{-amount} and (defined $par{-min_amount} or
				   defined $par{-max_amount})) {
	carp 'You must either specify -amount or -(max|min)_amount';
	return undef;
    }
    
    if (defined $par{-timestamp} and (defined $par{-min_timestamp} or
				      defined $par{-max_timestamp})) {
	carp 'You must either specify -timestamp or -(max|min)_timestamp';
	return undef;
    }

    for my $attr (keys %par) {
	my $field = $attr;
	$field =~ s/^-//;
	next if $field eq 'id' or $field eq 'db';
	if ($field eq 'min_amount' or $field eq 'min_timestamp') {
	    push @data, ["$field >= ?", $par{$attr}];
	} elsif ($field eq 'max_amount' or $field eq 'max_timestamp') {
	    push @data, ["$field <= ?", $par{$attr}];
        } elsif ($field eq 'person') {
	    push @data, ["person_id = ?", $par{$attr}];
	} else {
	    push @data, ["$field = ?", $par{$attr}];
	}
    }

    unless ($sth=$par{-db}->prepare(@data ? 'SELECT id FROM payment WHERE ' .
				    join(' AND ', map {$_->[0]} @data) :
				    'SELECT id FROM payment') and
	    $sth->execute(map({$_->[1]} @data))) {
	carp 'Unable to search for given criteria';
	return undef;
    }

    return map {$_->[0]} @{$sth->fetchall_arrayref};
}

sub get_payment_data {
    my (%par, @data, $sth);
    my $class = shift;
    %par = @_;

    for my $attr qw(db payment_id) {
	unless ($par{"-$attr"}) {
	    carp "Required attribute $attr missing";
	    return undef;
	}
    }

    for my $par (keys %par) {
	if (! grep {$par eq "-$_"} qw(db payment_id)) {
	    carp "Invocation error - Parameter $par unknown";
	    return undef;
	}
    }

    unless ($sth=$par{-db}->prepare('SELECT person_id, proposal_id, amount,
    admin_id, payment_type_id, timestamp from payment where id = ?') and
	    $sth->execute($par{-payment_id})) {
        carp 'Unable to get the data for that payment';
        return undef;
    }

    @data = $sth->fetchrow_array;
    $data[1] = undef if $data[1] eq 0;
    return @data;
}

sub calculate_amount {
    my (%par, $sth, $res);
    my $class = shift;
    %par = @_;
    $res = 0;

    for my $attr qw(db person) {
	unless ($par{"-$attr"}) {
	    carp "Required attribute $attr missing";
	    return undef;
	}
    }

    for my $par (keys %par) {
	if (! grep {$par eq "-$_"} qw(db person proposals date)) {
	    carp "Invocation error - Parameter $par unknown";
	    return undef;
	}
    }
    
    unless ((ref $par{-proposals}) eq 'ARRAY' || ! defined $par{-proposals} ) {
	carp 'Invocation error - proposals expects an array reference';
	return undef;
    }

    unless ((ref $par{-proposals}) eq 'ARRAY') {
        $par{-proposals} = [ 0 ];
    }
    # Date selection logic:
    # We get the latest date before the one specified. If no date was specified,
    # before today.
    # We will only use one value per data set, as we are interested only in the
    # price for the specified date.
    unless ($sth = $par{-db}->prepare('SELECT price.amount 
            FROM price, person, proposal
            WHERE person.person_type_id=price.person_type_id
            AND proposal.prop_type_id=price.prop_type_id
            AND person.id = ? AND proposal.id = ?
            AND price.until >= COALESCE (?, now()::date)
            ORDER BY price.until ASC')) {
        carp 'Error preparing query';
        return undef;
    }
    
    for my $prop (@{$par{-proposals}}) {
        my ($amount);
        # We don't check for success here - a particular prop_type might not 
        # have an entry for a particuar person_type, meaning that person does
        # not have to pay for the requested prop_type. We just protect ourselves
        # against warnings by assigning to the value or 0.
        $sth->execute($par{-person}, $prop, $par{-date});
        ($amount) = $sth->fetchrow_array or 0;
        
        if (defined $amount) { $res += $amount };
    }
    return $res;
}

sub get_capacity {
    my (%par, $sth, @res);
    my $class = shift;
    %par = @_;

    for my $attr qw(db proposal) {
	unless ($par{"-$attr"}) {
	    carp "Required attribute $attr missing";
	    return undef;
	}
    }
    
    for my $par (keys %par) {
	if (! grep {$par eq "-$_"} qw(db proposal)) {
	    carp "Invocation error - Parameter $par unknown";
	    return undef;
	}
    }

    unless ($sth = $par{-db}->prepare('SELECT count(*) from payment where
        proposal_id = ?')) {
        carp 'Error preparing query';
        return undef;
    }
    $sth->execute($par{-proposal});

    ($res[0]) = $sth->fetchrow_array;
    $res[0] = 0 unless ($res[0]);

    unless ($sth = $par{-db}->prepare('SELECT max_people FROM proposal p,
	timeslot t, room_prop_type_max_people rptm WHERE
        p.timeslot_id = t.id AND rptm.room_id = t.room_id AND
	rptm.prop_type_id = p.prop_type_id AND
	p.id = ?')) {
        carp 'Error preparing query';
        return undef;
    }
    $sth->execute($par{-proposal});

    ($res[1]) = $sth->fetchrow_array;
    $res[1] = 0 unless ($res[1]);

    return @res;
}

1;

# $Log: Payment.pm,v $
# Revision 1.14  2004/02/06 21:51:31  gwolf
# Agrego la función 'delete'
#
# Revision 1.13  2004/02/04 17:39:10  mig
# - Ajusto para que max_people lo saque de room_prop_type_max_people
#
# Revision 1.12  2004/02/03 02:44:58  mig
# - Corregido pequeño bug que evitaba pagos de '0'
#
# Revision 1.11  2004/01/23 07:48:01  mig
# - Agrego get_capacity y get_payment_data, no esta documentado, asi que si
#   alguien ve este log y sigue sin documentar, favor de mentarme la madre
#   (claro, especificando la razón).
# - Pongo a punto las demas funciones.
#
# Revision 1.10  2004/01/21 08:33:33  mig
# - Le hice el jalesito para que calculate_amount en caso de no existir proposals
#   vomite la entrada general.
#
# Revision 1.9  2004/01/20 17:48:28  mig
# - Pequeñas y humildes modificaciones :-P
#
# Revision 1.8  2004/01/13 20:57:51  gwolf
# Nace calculate_amount!
#
# Revision 1.7  2004/01/12 21:20:08  gwolf
# 75% de las funciones (o sea, 3 de 4 :-P ) listas (en estado '¿compila? ¡Está listo!'). Con esto como base ya debe ser posible darle al front-end de pagos.
#
# Revision 1.6  2004/01/06 22:19:46  gwolf
# Documento el API, aún no hay funcionalidad detrás
#
# Revision 1.5  2003/12/20 04:14:51  mig
# - Agrego tags Id y Log que expanda el CVS
#
