view release on metacpan or  search on metacpan

lib/EB/Relation.pm  view on Meta::CPAN

#! perl

# Relation.pm -- 
# Author          : Johan Vromans
# Created On      : Thu Jul 14 12:54:08 2005
# Last Modified By: Johan Vromans
# Last Modified On: Tue Apr 24 10:45:31 2018
# Update Count    : 130
# Status          : Unknown, Use with caution!

package main;

our $dbh;

package EB::Relation;

use strict;
use warnings;

use EB;

sub new {
    my $class = shift;
    $class = ref($class) || $class;
    my $self = {};
    bless $self => $class;
    $self->add(@_) if @_;
    $self;
}

sub add {
    my ($self, $code, $desc, $acct, $opts) = @_;
    my $bstate = $opts->{btw};
    my $dbk = $opts->{dagboek};

    if ( defined($bstate) ) {
	$bstate = lc($bstate);
	if ( $bstate =~ /^\d+$/ && $bstate >= 0 && $bstate < @{&BTWTYPES} ) {
	    # Ok.
	}
	elsif ( $bstate eq lc(BTWTYPES->[BTWTYPE_NORMAAL]) ) { $bstate = BTWTYPE_NORMAAL }
	elsif ( $bstate eq lc(BTWTYPES->[BTWTYPE_VERLEGD]) ) { $bstate = BTWTYPE_VERLEGD }
	elsif ( $bstate eq lc(BTWTYPES->[BTWTYPE_INTRA]  ) ) { $bstate = BTWTYPE_INTRA   }
	elsif ( $bstate eq lc(BTWTYPES->[BTWTYPE_EXTRA]  ) ) { $bstate = BTWTYPE_EXTRA   }
	else {
	    warn("?".__x("Ongeldige waarde voor BTW status: {btw}", btw => $bstate)."\n");
	    return;
	}
	if ( $bstate == BTWTYPE_VERLEGD ) {	#### TODO
	    warn("?"._T("Relaties met verlegde BTW worden nog niet ondersteund")."\n");
	    return;
	}
    }
    my $debiteur;
    my $ddesc;
    if ( $dbk ) {
	my $rr = $dbh->do("SELECT dbk_id, dbk_type, dbk_desc".
			       " FROM Dagboeken".
			       " WHERE dbk_desc ILIKE ?",
			  $dbk);
	unless ( $rr ) {
	    warn("?".__x("Onbekend dagboek: {dbk}", dbk => $dbk)."\n");
	    return;
	}
	my ($id, $type, $desc) = @$rr;
	if ( $type == DBKTYPE_INKOOP ) {
	    $debiteur = 0;
	}
	elsif ( $type == DBKTYPE_VERKOOP ) {
	    $debiteur = 1;
	}
	else {
	    warn("?".__x("Ongeldig dagboek voor relatie: {dbk}", dbk => $dbk)."\n");
	    return;
	}
	$dbk = $id;
	$ddesc = $desc;
    }

    # There are few restrictions on what can go in a relation code. A
    # colon is disallowed since that is used to separate the code from
    # a booking reference. Relation codes that start with digits and a
    # dash may lead to parse errors.
    if ( $code =~ /:/ || $code =~ /^\d+-/ ) {
	warn("?".__x("Ongeldige relatiecode: {rel}", rel => $code)."\n");
	return;