package wtr2_base;

use strict;

use DBI;
use Memoize;
memoize( 'sth_insert');

require Exporter;
@wtr2_base::ISA= qw(Exporter);
@wtr2_base::EXPORT= qw( %dir 
                        &init_db &rejected
                        &check_po &check_buyer &check_qtty &store_all
                        &reset_default_row_id &default_row_id
                      );

my $DEBUG=1;

# config
use vars qw( %dir);

%dir=( invoices  => 'invoices', # input data (invoices)
          rejected  => 'rejected', # rejected invoices
          check     => 'check',    # correct output (db + rejected invoices)
          db        => 'db',
        );

my $invoice_db     = "$dir{db}/invoice.db"    ;
my $invoice_db_def = "$dir{db}/invoice_db.def";

my $dbh; # yes, that's a global

##############################################################################
#                                                                            #
#  Check functions                                                           #
#                                                                            #
##############################################################################
                
# check that the buyer number in the invoice is really ours

{ my $ID   ="CL12221";               # our ID
  my $NAME ="Kalakauppa Vilkkunen";  # our name
  sub check_buyer
    { my( $id, $name, $errors)= @_;

      $id||=''; $name||='';
      
      if( !$id)                 { push @$errors, "missing buyer id number (BuyerPartyIdentifier)";                        }
      if( !$name)               { push @$errors, "missing buyer organization name (BuyerOrganisationName)";               }
      if( $id ne $ID)           { push @$errors, "wrong buyer id number (BuyerPartyIdentifier is /$id/, should be /$ID/"; }
      if(lc  $name ne lc $NAME) { push @$errors, "wrong buyer name (BuyerOrganisationName is /$name/, should be /$NAME/"; }

      return( ($id eq $ID) and (lc $name eq lc $NAME) );
    }
}

# check whether the PO exists and if it can be found in the po table
sub check_po
  { my( $po, $errors)= @_;

    if( $po) 
      { if( exist_po( $po))
          { return 1; }
        else
          { push @$errors, "unknown PO $po (in OrderIdentifier element)";
            return 0;
          }
      }
    else
      { push @$errors, "cannot find PO (in OrderIdentifier element)"; 
        return 0;
      }
  }
    
# check that ordered and delivered quantities and units are the same
sub check_qtty
  { my( $row, $delivered_qtty, $delivered_unit, $ordered_qtty, $ordered_unit, $errors)= @_;

    $delivered_qtty ||=0; $delivered_unit ||='';
    $ordered_qtty   ||=0; $ordered_unit   ||='';

    if( ($delivered_qtty eq $ordered_qtty) and ($delivered_unit eq $ordered_unit) )
      { #print "quantity ok row $row (ordered $ordered_qtty $ordered_unit, delivered $delivered_qtty $delivered_unit)\n" if $DEBUG;
        return 1;
      }
    else
      { $delivered_qtty ||= '[no quantity]';
        $ordered_qtty   ||= '[no quantity]';
        $delivered_unit ||= '[no unit]';
        $ordered_unit   ||= '[no unit]';
        push @$errors, "quantity problem row $row (ordered $ordered_qtty $ordered_unit, delivered $delivered_qtty $delivered_unit)";
        return 0;
      }
  }

# return the rejected file name from the originl file name
sub rejected
  { my $file= shift;
    (my $rejected= $file)=~ s{^.*/(.*)\.xml$}{$dir{rejected}/$1.rejected.xml};
    return $rejected;
  }
    


##############################################################################
#                                                                            #
#  DB-related functions                                                      #
#                                                                            #
##############################################################################

sub init_db
  { unlink <$dir{rejected}/*.xml>;
    unlink $invoice_db;
    system "sqlite $invoice_db < $invoice_db_def"; 
    $dbh= DBI->connect("dbi:SQLite:dbname=$invoice_db","","",
                       { RaiseError => 1, AutoCommit => 0 }
                      ) or die "cannot connect to database: $DBI::errstr";
  }

sub exist_po
  { my $po= shift;
    my $sth= $dbh->prepare( q{SELECT count(*) FROM po WHERE po = ?});
    $sth->execute( $po);
    my $count= $sth->fetchrow_array;
    return $count;
  }
    
  { my $default_row_id;
    sub reset_default_row_id { $default_row_id=0; }
    sub default_row_id { return sprintf( "gen_%03s", ++$default_row_id); }
  }
          
sub new_id
  { my( $table)= @_;
    my $sth= $dbh->prepare( qq{SELECT max($table\_id) FROM $table});
    $sth->execute;
    my $last_id= $sth->fetchrow_array;
    $last_id||=0;
    my $new_id= $last_id+1;
    return $new_id;
  }


sub sth_insert
  { my( $table, @fields)= @_;
    my $fields        = join ',', @fields;
    my $place_holders = join ',', map { '?' } @fields;
  
    my $sql= qq{INSERT INTO $table ($fields) VALUES ($place_holders)};
    my $sth= $dbh->prepare( $sql);

    return $sth;
  }


sub insert_record
  { my( $table, $record)= @_;
    #print "INSERT in $table ", join ( " - ", map { "$_: " . ($record->{$_} || 'undef') } keys %$record), "\n" if $DEBUG;
    print "INSERT in $table ", join ( " - ", map { "$_: " . ($record->{$_} || 'undef') } keys %$record), "\n" if $DEBUG;
    my $sth_insert=  sth_insert( $table => keys %$record);
    $sth_insert->execute( values %$record);
  }

  
sub store_all
  { my( $data)= @_; 
    
    eval
     { my $address            = $data->{address};
       $address->{address_id} = new_id( 'address');
       insert_record( address => $address); 

       my $contact            = $data->{contact};
       $contact->{person_id}  = new_id( 'person');
       insert_record( person  => $contact); 

       my $seller             = $data->{seller};
       $seller->{seller_id}   = new_id( 'seller');
       $seller->{address}     = $address->{address_id};
       insert_record( seller  => $seller); 

       my $invoice            = $data->{invoice};
       $invoice->{invoice_id} =  new_id( 'invoice');
       $invoice->{seller}     = $seller->{seller_id};
       $invoice->{seller_contact} = $contact->{person_id};
       insert_record( invoice => $invoice); 

       my $invoicerow_id= new_id( 'invoicerow');
       foreach my $invoicerow (@{$data->{invoicerow}})
         { $invoicerow->{invoicerow_id} = $invoicerow_id++;
           $invoicerow->{invoice}       = $invoice->{invoice_id};
           insert_record( invoicerow    => $invoicerow); 
         }

       $dbh->commit;   # commit the changes if we get this far

     };

    if ($@)
      { warn "Transaction aborted because $@";
        $dbh->rollback; # undo the incomplete changes
      }
  } 

1;

__END__
=head1 NAME

wtr2_base
 
=head1 SYNOPSYS

  see wtr2_* for how to use this
  

=head1 DESCRIPTION

Provides basic functions for the various wtr2 scripts

=head1 FUNCTIONS

=over 4

=item check_buyer ( $id, $name, $errors)

Check that the $id and $name of the buyer are OK in the invoice

Return 1 if name and id are OK, else return 0 and add error message(s) to $errors


=item check_po ( $po, $errors)

Checks that the $po (purchase order) exists in the data base.

Return 1 if it exists, else return 0 and add error message to $errors


=item check_qtty ( $row, $delivered_qtty, $delivered_unit, $ordered_qtty, $ordered_unit, $errors)

Check that the quantity delivered is the same as the quantity ordered for each invoice row

Return 1 if quantities are OK, else return 0 and add error message to $errors


=item store_all ( $data)

Store all data for an invoice.

$data should hold the data extracted from the XML in this format:

  {
    invoice    => { number => <data>, date => <data>,
                    payment_status => <data>, po => <data>
                    amount_no_tax => <data>, amount => <data>, tax => <data>
                  },
    seller     => { identifier => <data>, name =><data>, tax_code => <data> },
    address    => { street => <data>, town => <data>, zip => <data>, country_code => <data>, po_box => <data> },
    contact    => { name => <data>, email => <data>, phone => <data> },
    invoicerow => [ { row_id => <data>, sku => <data>, name => <data>,
                      qty => <data>, qty_unit => <data>, unit_price => <data>,
                      amount => <data>, amount_no_tax => <data>, tax => <data>
                    },
                    { ... },
                 ]    
  }

store_all will add the links between records in the various tables (the FOREIGN KEYs)


=item reset_default_row_id 

Set the default_row_id to 0

=item default_row_id

Generate a default row id for those rows which do not have one

=back

=head1 AUTHOR

Michel Rodriguez <mirod@xmltwig.com>

=head1 LICENSE

This code is Copyright (c) 2003 Michel Rodriguez. All rights reserved.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

Comments can be sent to mirod@xmltwig.com

=head1 SEE ALSO

DBI, DBD::SQLite, Memoize

Ways to Rome 2 - Kourallinen Dollareita - http://www.xmltwig.com/article/ways_to_rome_2/