mirror of
https://github.com/imapsync/imapsync.git
synced 2024-11-17 08:12:48 +01:00
1173 lines
36 KiB
Perl
Executable File
1173 lines
36 KiB
Perl
Executable File
#!/usr/bin/perl
|
||
|
||
# $Id: paypal_bilan,v 1.58 2012/08/11 00:01:46 gilles Exp gilles $
|
||
|
||
use strict;
|
||
use warnings;
|
||
use Getopt::Long;
|
||
use Text::CSV_XS ;
|
||
use IO::Handle ;
|
||
use Data::Dumper ;
|
||
use Unicode::MapUTF8 qw(to_utf8 from_utf8 utf8_supported_charset);
|
||
use Test::More 'no_plan' ;
|
||
|
||
die unless (utf8_supported_charset('ISO-8859-1'));
|
||
|
||
my $rcs = '$Id: paypal_bilan,v 1.58 2012/08/11 00:01:46 gilles Exp gilles $ ' ;
|
||
$rcs =~ m/,v (\d+\.\d+)/ ;
|
||
my $VERSION = ($1) ? $1: "UNKNOWN" ;
|
||
|
||
|
||
my $total_usd_received = 0 ;
|
||
my $total_usd_invoice = 0 ;
|
||
my $total_HT_EUR_exo = 0 ;
|
||
my $total_HT_EUR_ass = 0 ;
|
||
my $total_TVA_EUR = 0 ;
|
||
|
||
my $total_HT_EUR_sup = 0 ;
|
||
my $total_TVA_EUR_sup = 0 ;
|
||
|
||
my $total_eur_received = 0 ;
|
||
my $total_eur_invoice = 0 ;
|
||
my $nb_invoice = 0 ;
|
||
my $nb_invoice_refund = 0 ;
|
||
my $nb_invoice_suspended = 0 ;
|
||
my $nb_invoice_canceled = 0 ;
|
||
|
||
my ( $tests, $testeur ) ;
|
||
my $debug ;
|
||
my $debug_csv ;
|
||
my $debug_dev ;
|
||
my $debug_invoice ;
|
||
my $debug_invoice_utf8 ;
|
||
|
||
my $first_invoice = 1 ;
|
||
my $print_details = '' ;
|
||
my $bnc = '' ;
|
||
my $exportbnc = '' ;
|
||
|
||
my $usdeur = 1.2981 ;
|
||
my $invoices ;
|
||
my %invoice_refund ;
|
||
my %invoice_canceled ;
|
||
my %invoice_suspended ;
|
||
my $write_invoices = 0 ;
|
||
my $avoid_numbers ;
|
||
|
||
my $dir_invoices = '/g/var/paypal_invoices' ;
|
||
|
||
my $option_ret = GetOptions (
|
||
'tests' => \$tests,
|
||
'debug' => \$debug,
|
||
'debug_csv' => \$debug_csv,
|
||
'debug_dev' => \$debug_dev,
|
||
'debug_invoice' => \$debug_invoice,
|
||
'debug_invoice_utf8' => \$debug_invoice_utf8,
|
||
|
||
'first_invoice=i' => \$first_invoice,
|
||
'print_details|details' => \$print_details,
|
||
'bnc' => \$bnc,
|
||
'exportbnc=s' => \$exportbnc,
|
||
'usdeur=f' => \$usdeur,
|
||
'invoices=s' => \$invoices,
|
||
'write_invoices!' => \$write_invoices,
|
||
'avoid_numbers=s' => \$avoid_numbers,
|
||
);
|
||
|
||
$testeur = Test::More->builder ;
|
||
$testeur->no_ending(1) ;
|
||
|
||
if ( $tests ) {
|
||
$testeur->no_ending( 0 ) ;
|
||
exit( tests( ) ) ;
|
||
}
|
||
|
||
|
||
my @files = @ARGV ;
|
||
my %action_of_invoice ;
|
||
|
||
my %invoice_paypal ;
|
||
#$invoice_paypal{ $first_invoice } = 1 ;
|
||
|
||
my @invoices_wanted = split( /\s+/, $invoices ) if $invoices ;
|
||
|
||
my @avoid_numbers = split( /\s+/, $avoid_numbers ) if $avoid_numbers ;
|
||
my %avoid_numbers ;
|
||
@avoid_numbers{ @avoid_numbers } = ( ) if @avoid_numbers ;
|
||
|
||
#print "@invoices\n" ;
|
||
|
||
foreach my $file ( @files ) {
|
||
|
||
my @actions = parse_file( $file ) ;
|
||
|
||
foreach my $action (@actions) {
|
||
my %action = %$action ;
|
||
#print $action->{ Nom }, "\n" ;
|
||
my( $Date, $Heure, $Fuseau_horaire, $Nom, $Type, $Etat,
|
||
$Devise, $Montant, $Numero_davis_de_reception, $Solde,
|
||
$Pays, $Nom_Option_1, $Valeur_Option_1, $Hors_taxe, $Titre_de_l_objet, $Nom_Option_2, $Option_2_Valeur )
|
||
= @action{ ( 'Date', 'Heure', 'Fuseau horaire', 'Nom', 'Type', 'Etat',
|
||
'Devise', 'Montant', "Num<75>ro d'avis de r<>ception", 'Solde',
|
||
'Pays', 'Nom Option 1', 'Valeur Option 1', 'Hors taxe', "Titre de l'objet", 'Nom Option 2', 'Option 2 Valeur') } ;
|
||
#print "$Nom\n" ;
|
||
( $Etat ) = @action{ ( 'Etat', ) } || @action{ ( '<27>tat' ) } ;
|
||
my $invoice = 'NONE' ;
|
||
$Montant = $action->{ Net } if not defined $Montant;
|
||
compute_line($action, $invoice, $Date, $Heure, $Fuseau_horaire, $Nom, $Type, $Etat,
|
||
$Devise, $Montant, $Numero_davis_de_reception, $Solde,
|
||
$Pays, $Nom_Option_1, $Valeur_Option_1, $Hors_taxe, $Titre_de_l_objet ) ;
|
||
|
||
# index by invoice number
|
||
$action_of_invoice{ $action->{ 'invoice' } } = $action ;
|
||
}
|
||
delete $action_of_invoice{ 'NONE' } ;
|
||
}
|
||
|
||
my $last_invoice ;
|
||
my @invoice_paypal = sort { $a <=> $b } keys %invoice_paypal ;
|
||
$last_invoice = $invoice_paypal[-1] || 0 ;
|
||
my $first_invoice_paypal = $invoice_paypal[0] || 0 ;
|
||
|
||
@invoices_wanted = ( $first_invoice .. $last_invoice ) if ( ! @invoices_wanted ) ;
|
||
|
||
my @invoice_sent ;
|
||
my %invoice_sent ;
|
||
my @invoice_not_sent ;
|
||
my %invoice_not_sent ;
|
||
|
||
foreach my $invoice ( @invoices_wanted ) {
|
||
|
||
my $action = $action_of_invoice{ $invoice } ;
|
||
next if ! $action ;
|
||
my $email_address = $action->{ "De l'adresse email" } ;
|
||
|
||
my $invoice_sent = invoice_sent( $dir_invoices, $invoice, $email_address ) ;
|
||
#print "$invoice $invoice_sent\n" ;
|
||
|
||
if ( $invoice_sent ) {
|
||
$invoice_sent{ $invoice }++ ;
|
||
#build_invoice( $invoice ) ;
|
||
}elsif( not ( $invoice_canceled{ $invoice } or $invoice_refund{ $invoice } ) ) {
|
||
$invoice_not_sent{ $invoice }++ ;
|
||
build_invoice( $invoice ) ;
|
||
}
|
||
}
|
||
|
||
@invoice_sent = sort { $a <=> $b } keys( %invoice_sent ) ;
|
||
my $nb_invoice_sent = scalar( @invoice_sent ) ;
|
||
@invoice_not_sent = sort { $a <=> $b } keys( %invoice_not_sent ) ;
|
||
|
||
my @invoice_canceled = sort { $a <=> $b } keys( %invoice_canceled ) ;
|
||
my @invoice_suspended = sort { $a <=> $b } keys( %invoice_suspended ) ;
|
||
my @invoice_refund = sort { $a <=> $b } keys( %invoice_refund ) ;
|
||
|
||
|
||
print( "\n", "=" x 60, "\n" ) if $bnc ;
|
||
|
||
|
||
|
||
print "USD banque $total_usd_received\n" ;
|
||
print "USD invoice $total_usd_invoice\n" ;
|
||
my $total_eur_from_usd ;
|
||
$total_eur_from_usd = sprintf('%2.2f', $total_usd_invoice / $usdeur ) ; # au 30 nov 2010 http://fr.finance.yahoo.com/devises/convertisseur/#from=EUR;to=USD;amt=1
|
||
print "EUR from USD $total_eur_from_usd\n" ;
|
||
print "EUR banque $total_eur_received\n" ;
|
||
print "EUR invoice $total_eur_invoice\n" ;
|
||
|
||
my $total_eur = $total_eur_from_usd + $total_eur_invoice ;
|
||
|
||
$total_HT_EUR_exo = sprintf('%2.2f', $total_HT_EUR_exo) ;
|
||
$total_HT_EUR_ass = sprintf('%2.2f', $total_HT_EUR_ass) ;
|
||
$total_TVA_EUR = sprintf('%2.2f', $total_TVA_EUR) ;
|
||
|
||
$total_HT_EUR_sup = sprintf('%2.2f', $total_HT_EUR_sup) ;
|
||
$total_TVA_EUR_sup = sprintf('%2.2f', $total_TVA_EUR_sup) ;
|
||
|
||
$total_eur = sprintf('%2.2f', $total_eur) ;
|
||
|
||
print "EUR total $total_eur\n" ;
|
||
print "EUR total HT exo $total_HT_EUR_exo\n" ;
|
||
print "EUR total HT assuj $total_HT_EUR_ass\n" ;
|
||
print "EUR total TVA $total_TVA_EUR\n" ;
|
||
print "EUR total HT sup $total_HT_EUR_sup\n" ;
|
||
print "EUR total TVA sup $total_TVA_EUR_sup\n" ;
|
||
print "Nb invoice $nb_invoice ( from $first_invoice_paypal to $last_invoice )\n" ;
|
||
print "Nb invoice canceled ($nb_invoice_canceled) @invoice_canceled\n" ;
|
||
print "Nb invoice suspended ($nb_invoice_suspended) @invoice_suspended\n" ;
|
||
print "Nb invoice refund ($nb_invoice_refund) @invoice_refund\n" ;
|
||
print "Nb invoice sent $nb_invoice_sent\n" ;
|
||
print "Have to send invoices @invoice_not_sent\n" if ( @invoice_not_sent ) ;
|
||
|
||
my $total_eur2 = $total_HT_EUR_exo + $total_HT_EUR_ass + $total_TVA_EUR + $total_HT_EUR_sup + $total_TVA_EUR_sup ;
|
||
print "$total_eur != $total_eur2 = $total_HT_EUR_exo + $total_HT_EUR_ass + $total_TVA_EUR + $total_HT_EUR_sup + $total_TVA_EUR_sup\n"
|
||
if ( $total_eur != $total_eur2 ) ;
|
||
|
||
sub parse_one_line_io {
|
||
my $csv = shift ;
|
||
my $io = shift ;
|
||
|
||
my $line = $csv->getline($io) ;
|
||
|
||
return if ( $csv->eof( ) ) ;
|
||
if ( not defined( $line ) ) {
|
||
my($cde, $str, $pos) = $csv->error_diag () ;
|
||
print "[$cde] [$str] [$pos]\n" ;
|
||
|
||
}
|
||
return( $line ) ;
|
||
}
|
||
|
||
sub hash_and_count_dupplicate {
|
||
my @columns = @_ ;
|
||
my %columns ;
|
||
|
||
#@columns_def{ @columns_def } = ( ) ;
|
||
foreach my $col ( @columns ) {
|
||
$columns{ $col } += 1 ;
|
||
}
|
||
$debug_csv and print "Nb columns: ", scalar( keys %columns ), " ", scalar( @columns ), "\n" ;
|
||
# debug how many time a title is defined
|
||
foreach my $col (1 .. scalar( @columns )) {
|
||
$debug_csv and print "$col | ",
|
||
deci_to_AA( $col ) , " | ",
|
||
$columns{ $columns[ $col - 1 ] }, " | ",
|
||
$columns[ $col - 1 ], "\n" ;
|
||
}
|
||
|
||
# exit in case two columns have the same name
|
||
die "Erreur : doublons dans les titres\n" if ( scalar( keys %columns ) != scalar( @columns ) ) ;
|
||
|
||
return( %columns ) ;
|
||
}
|
||
|
||
sub deci_to_AA {
|
||
my $deci = shift ;
|
||
my $AA = '';
|
||
|
||
while ( $deci > 0 ) {
|
||
my $quot = int( ( $deci - 1 ) / 26 ) ;
|
||
my $rest = $deci - 1 - ( 26 * $quot ) ;
|
||
my $char = chr ( ord('A') + $rest ) ;
|
||
$AA = $char . $AA ;
|
||
$deci = $quot ;
|
||
}
|
||
#print "col=$AA\n" ;
|
||
return( $AA ) ;
|
||
}
|
||
|
||
sub remove_first_blank {
|
||
my $string = shift ;
|
||
|
||
$string =~ s/^ +// ;
|
||
return( $string ) ;
|
||
|
||
}
|
||
|
||
sub parse_file {
|
||
my $file = shift ;
|
||
|
||
open my $io, "<", $file or die "$file: $!" ;
|
||
|
||
my $csv = Text::CSV_XS->new( {
|
||
sep_char => ',',
|
||
binary => 1,
|
||
keep_meta_info => 1,
|
||
eol => $/,
|
||
} ) ;
|
||
|
||
my $line_1 = parse_one_line_io( $csv, $io ) ;
|
||
die if ( not defined $line_1 ) ; # first line must have no problem
|
||
|
||
my @columns_def_orig = @$line_1 ;
|
||
my @columns_def = map { remove_first_blank( $_ ) } @columns_def_orig ;
|
||
$debug_csv and print "columns_def = ", map( { "[$_]" } @columns_def ), "\n";
|
||
|
||
my %columns_def = hash_and_count_dupplicate( @columns_def ) ;
|
||
my $nb_columns_def = scalar @columns_def ;
|
||
|
||
my $line_counter = 2 ;
|
||
my @actions ;
|
||
while ( 1 ) {
|
||
$debug_csv and print "ligne $line_counter ", $csv->eof( ), "\n" ;
|
||
my $line = parse_one_line_io( $csv, $io ) ;
|
||
last if ( $csv->eof( ) ) ;
|
||
if ( not defined $line ) {
|
||
print "Erreur ligne $line_counter : ", $csv->error_diag, "\n\n";
|
||
++$line_counter ;
|
||
next ;
|
||
}
|
||
my @columns = @$line ;
|
||
|
||
if ( $nb_columns_def != scalar @columns ) {
|
||
print "Erreur ligne $line_counter : nombre de colonnes = ", scalar @columns, " != $nb_columns_def\n" ;
|
||
++$line_counter ;
|
||
next ;
|
||
}
|
||
my %columns ;
|
||
@columns{ @columns_def } = @columns ;
|
||
$columns{ 'file_csv' } = $file ;
|
||
$columns{ 'line_number' } = $line_counter ;
|
||
$csv->combine( @columns ) ;
|
||
my $line_csv = $csv->string();
|
||
$columns{ 'line_csv' } = $line_csv ;
|
||
$debug_csv and print map( { "[$_] = [" . $columns{$_} . "]\n" }
|
||
@columns_def, 'line_number', 'line_csv', 'file_csv' ),
|
||
"\n";
|
||
++$line_counter ;
|
||
push( @actions, \%columns ) ;
|
||
}
|
||
close( $io );
|
||
return( reverse @actions ) ;
|
||
}
|
||
|
||
sub next_invoice {
|
||
my @current_numbers = sort { $a <=> $b } ( $first_invoice - 1, keys( %invoice_paypal ) ) ;
|
||
my $last_invoice = $current_numbers[ -1 ] || 0 ;
|
||
|
||
#keys( %avoid_numbers ),
|
||
my $next_invoice = $last_invoice + 1 ;
|
||
while ( exists( $avoid_numbers{ $next_invoice } ) ) { $next_invoice++ ; }
|
||
$invoice_paypal{ $next_invoice } = 1 ;
|
||
#print "AAA [@current_numbers] [$last_invoice] [$next_invoice]\n" ;
|
||
|
||
return( $next_invoice ) ;
|
||
}
|
||
|
||
sub keyval {
|
||
my %hash = @_ ;
|
||
return( join( " ", map( { "$_ => " . $hash{ $_ } } keys %hash ) ) . "\n" ) ;
|
||
}
|
||
|
||
|
||
sub tests_next_invoice {
|
||
ok( 1 == next_invoice( ), 'next_invoice: 1' ) ;
|
||
ok( 2 == next_invoice( ), 'next_invoice: 2' ) ;
|
||
@avoid_numbers{ (3, 4, 6, 8 ) } = ( ) ;
|
||
ok( 5 == next_invoice( ), 'next_invoice: 7' ) ;
|
||
ok( 7 == next_invoice( ), 'next_invoice: 8' ) ;
|
||
ok( 9 == next_invoice( ), 'next_invoice: 9' ) ;
|
||
%invoice_paypal = () ;
|
||
$first_invoice = 7 ;
|
||
ok( 7 == next_invoice( ), 'next_invoice: 7' ) ;
|
||
}
|
||
|
||
|
||
sub tests {
|
||
tests_next_invoice( ) ;
|
||
#tests_half( ) ;
|
||
tests_cut( ) ;
|
||
}
|
||
|
||
sub compute_line {
|
||
my( $action, $invoice, $Date, $Heure, $Fuseau_horaire, $Nom, $Type, $Etat,
|
||
$Devise, $Montant, $Numero_davis_de_reception, $Solde,
|
||
$Pays, $Nom_Option_1, $Valeur_Option_1, $Hors_taxe_paypal, $Titre_de_l_objet ) = @_ ;
|
||
|
||
$debug and print( "-" x 60, "\n",
|
||
"[$Date] [$Heure] [$Fuseau_horaire] [$Nom] [$Type] [$Etat] ",
|
||
"[$Devise] [$Hors_taxe_paypal] [$Montant] [$Numero_davis_de_reception] [$Solde]\n",
|
||
"[$Pays] [$Nom_Option_1] [$Valeur_Option_1] [$Titre_de_l_objet]\n" ) ;
|
||
|
||
$Montant =~ s/[^0-9-,.]//g ;
|
||
$Montant =~ s/,/./g ;
|
||
#$debug and print "MM[$Montant]\n" ;
|
||
$Hors_taxe_paypal =~ s/,/./g ;
|
||
|
||
my $MontantEUR;
|
||
my( $montant_HT_EUR_exo, $montant_HT_EUR_ass, $montant_TVA_EUR ) ;
|
||
my( $montant_HT_EUR_sup, $montant_TVA_EUR_sup ) ;
|
||
|
||
if ( $bnc ) {
|
||
$MontantEUR = $Montant ;
|
||
$MontantEUR = sprintf( "%.4f", $Montant/$usdeur ) if ($Devise eq 'USD') ;
|
||
print( "\n", "=" x 60, "\n" ) ;
|
||
print( "[$Date] [$Nom] [$Type] [$Etat] [$Devise] [$Hors_taxe_paypal] [$Montant] [EUR $MontantEUR]\n",
|
||
"[$Pays] [$Nom_Option_1] [$Valeur_Option_1] [$Titre_de_l_objet]\n" ) ;
|
||
}
|
||
|
||
if (
|
||
'Paiement sur site marchand re<72>u' eq $Type
|
||
and 'USD' eq $Devise
|
||
and ( 'Termin<69>' eq $Etat or 'Compens<6E>' eq $Etat )
|
||
) {
|
||
$Montant =~tr/,/./;
|
||
#print "$Montant\n" ;
|
||
my $Montant2_usd;
|
||
$Montant2_usd = $Hors_taxe_paypal ;
|
||
$total_usd_received += $Montant ;
|
||
$total_usd_invoice += $Montant2_usd ;
|
||
( $montant_HT_EUR_exo, $montant_HT_EUR_ass, $montant_TVA_EUR, $montant_HT_EUR_sup, $montant_TVA_EUR_sup )
|
||
= tva_line( $Devise, $Montant2_usd, $Pays, $Nom_Option_1, $Valeur_Option_1, $Titre_de_l_objet ) ;
|
||
$total_HT_EUR_exo += $montant_HT_EUR_exo ;
|
||
$total_HT_EUR_ass += $montant_HT_EUR_ass ;
|
||
$total_TVA_EUR += $montant_TVA_EUR ;
|
||
#$invoice = $first_invoice + $nb_invoice ;
|
||
$invoice = next_invoice( ) ;
|
||
$nb_invoice++ ;
|
||
$print_details and print ( "[$invoice] [$Date] [$Heure] [$Fuseau_horaire] [$Nom] [$Type] [$Etat] [$Devise] [$Montant] [$Numero_davis_de_reception] [$Solde]\n" ) ;
|
||
|
||
}
|
||
|
||
if (
|
||
'Paiement sur site marchand re<72>u' eq $Type
|
||
and 'EUR' eq $Devise
|
||
and ( 'Termin<69>' eq $Etat or 'Compens<6E>' eq $Etat )
|
||
) {
|
||
$Montant =~tr/,/./;
|
||
#print "$Montant\n" ;
|
||
my $Montant2_eur;
|
||
$Montant2_eur = $Hors_taxe_paypal ;
|
||
$total_eur_received += $Montant ;
|
||
$total_eur_invoice += $Montant2_eur ;
|
||
( $montant_HT_EUR_exo, $montant_HT_EUR_ass, $montant_TVA_EUR, $montant_HT_EUR_sup, $montant_TVA_EUR_sup )
|
||
= tva_line( $Devise, $Montant2_eur, $Pays, $Nom_Option_1, $Valeur_Option_1, $Titre_de_l_objet ) ;
|
||
$total_HT_EUR_exo += $montant_HT_EUR_exo ;
|
||
$total_HT_EUR_ass += $montant_HT_EUR_ass ;
|
||
$total_TVA_EUR += $montant_TVA_EUR ;
|
||
$total_HT_EUR_sup += $montant_HT_EUR_sup ;
|
||
$total_TVA_EUR_sup += $montant_TVA_EUR_sup ;
|
||
|
||
|
||
#$invoice = $first_invoice + $nb_invoice ;
|
||
$invoice = next_invoice( ) ;
|
||
$nb_invoice++ ;
|
||
$print_details and print ( "[$invoice] [$Date] [$Heure] [$Fuseau_horaire] [$Nom] [$Type] [$Etat] [$Devise] [$Montant] [$Numero_davis_de_reception] [$Solde]\n" ) ;
|
||
}
|
||
|
||
if (
|
||
'Paiement sur site marchand re<72>u' eq $Type
|
||
and 'EUR' eq $Devise
|
||
and 'Rembours<72>' eq $Etat
|
||
) {
|
||
$invoice = next_invoice( ) ;
|
||
$nb_invoice++ ;
|
||
$nb_invoice_refund++;
|
||
$invoice_refund{ $invoice }++ ;
|
||
|
||
$print_details and print ( "[$invoice] [$Date] [$Heure] [$Fuseau_horaire] [$Nom] [$Type] [$Etat] [$Devise] [$Montant] [$Numero_davis_de_reception] [$Solde]\n" ) ;
|
||
}
|
||
|
||
if (
|
||
'Paiement sur site marchand re<72>u' eq $Type
|
||
and 'EUR' eq $Devise
|
||
and 'Annul<75>' eq $Etat
|
||
) {
|
||
$invoice = next_invoice( ) ;
|
||
$nb_invoice++ ;
|
||
$nb_invoice_canceled++;
|
||
$invoice_canceled{ $invoice }++ ;
|
||
|
||
$print_details and print ( "[$invoice] [$Date] [$Heure] [$Fuseau_horaire] [$Nom] [$Type] [$Etat] [$Devise] [$Montant] [$Numero_davis_de_reception] [$Solde]\n" ) ;
|
||
}
|
||
|
||
if (
|
||
'Paiement sur site marchand re<72>u' eq $Type
|
||
and 'EUR' eq $Devise
|
||
and 'Suspendu' eq $Etat
|
||
) {
|
||
$invoice = next_invoice( ) ;
|
||
$nb_invoice++ ;
|
||
$nb_invoice_suspended++;
|
||
$invoice_suspended{ $invoice }++ ;
|
||
|
||
$print_details and print ( "[$invoice] [$Date] [$Heure] [$Fuseau_horaire] [$Nom] [$Type] [$Etat] [$Devise] [$Montant] [$Numero_davis_de_reception] [$Solde]\n" ) ;
|
||
}
|
||
|
||
if (
|
||
'Paiement sur site marchand re<72>u' eq $Type
|
||
and 'EUR' eq $Devise
|
||
and 'Non compens<6E>' eq $Etat
|
||
) {
|
||
$invoice = next_invoice( ) ;
|
||
$nb_invoice++ ;
|
||
$print_details and print ( "[$invoice] [$Date] [$Heure] [$Fuseau_horaire] [$Nom] [$Type] [$Etat] [$Devise] [$Montant] [$Numero_davis_de_reception] [$Solde]\n" ) ;
|
||
}
|
||
|
||
$action->{ 'invoice' } = $invoice ;
|
||
if ( $bnc ) {
|
||
my $FR_flag = '' ;
|
||
$FR_flag = ' FR' if $Pays eq 'France' ;
|
||
my $IND_flag = '' ;
|
||
$IND_flag = ' IND' if ('imapsync usage' eq $Nom_Option_1 and 'individual' eq $Valeur_Option_1 ) ;
|
||
my $SUPPORT_flag = '' ;
|
||
$SUPPORT_flag = ' support' if ( 'imapsync support' eq $Titre_de_l_objet ) ;
|
||
#print "FE $invoice$FR_flag$IND_flag\n" ;
|
||
#printf( "%.2f [EUR %.2f]\n", $Montant, $MontantEUR ) ;
|
||
print "FE $invoice$FR_flag$IND_flag imapsync$SUPPORT_flag $Nom\n" ;
|
||
print "[$Date]$FR_flag$IND_flag $MontantEUR $Devise \n" ;
|
||
}
|
||
}
|
||
|
||
sub build_invoice {
|
||
my $invoice = shift ;
|
||
|
||
return if ! $invoice ;
|
||
|
||
my $action = $action_of_invoice{ $invoice } ;
|
||
my $refund = '' ;
|
||
$refund = 'REFUND ' if $invoice_refund{ $invoice } ;
|
||
my %action = %$action if $action ;
|
||
#print Data::Dumper->Dump( [$action] ) ;
|
||
|
||
my( $Date, $Heure, $Nom, $Type, $Etat, $Devise, $Hors_taxe, $Commission, $Net,
|
||
$De_l_adresse_email, $A_l_adresse_email, $N_de_transaction, $Titre_de_l_objet,
|
||
$TVA, $Nom_Option_1, $Valeur_Option_1, $N_de_transaction_de_reference,
|
||
$Adresse_1, $Adresse_2_district_quartier, $Ville,
|
||
$Etat_Province, $Code_postal, $Pays, $line_number, $line_csv, $file_csv,
|
||
$Nom_Option_2, $Option_2_Valeur )
|
||
= @action{ ( 'Date', 'Heure', 'Nom', 'Type', 'Etat', 'Devise', 'Hors taxe', 'Commission', 'Net',
|
||
"De l'adresse email", "A l'adresse email", 'N<> de transaction', "Titre de l'objet",
|
||
'TVA', 'Nom Option 1', 'Valeur Option 1', 'N<> de transaction de r<>f<EFBFBD>rence',
|
||
'Adresse 1', 'Adresse 2/district/quartier', 'Ville',
|
||
'Etat/Province/R<>gion/Comt<6D>/Territoire/Pr<50>fecture/R<>publique', 'Code postal', 'Pays', 'line_number', 'line_csv', 'file_csv',
|
||
'Nom Option 2', 'Option 2 Valeur' ) } ;
|
||
|
||
my( $Etat_Province1 ) = @action{ ( 'Etat/Province/R<>gion/Comt<6D>/Territoire/Pr<50>fecture/R<>publique' ) } ;
|
||
my( $Etat_Province2 ) = @action{ ( '<27>tat/Province/R<>gion/Comt<6D>/Territoire/Pr<50>fecture/R<>publique' ) } ;
|
||
|
||
$Etat_Province = @action{ ( 'Etat/Province/R<>gion/Comt<6D>/Territoire/Pr<50>fecture/R<>publique' ) }
|
||
|| @action{ ( '<27>tat/Province/R<>gion/Comt<6D>/Territoire/Pr<50>fecture/R<>publique' ) }
|
||
|| '' ;
|
||
|
||
#print "$Hors_taxe $Devise\n" ;
|
||
my $Hors_taxe_num = $Hors_taxe ;
|
||
$Hors_taxe_num =~ s{,}{.} ;
|
||
if ($Hors_taxe_num > 100) {
|
||
print "invoice $invoice $Hors_taxe_num > 100\n" ;
|
||
#return() ;
|
||
}
|
||
|
||
my ( $email_message_header, $email_message_body )
|
||
= build_email_message( $Date, $Nom, $De_l_adresse_email, $invoice, $Titre_de_l_objet ) ;
|
||
if ( $write_invoices and ! invoice_sent( $dir_invoices, $invoice, $De_l_adresse_email ) ) {
|
||
write_email_message( $dir_invoices, $invoice,
|
||
$email_message_header, $email_message_body,
|
||
$De_l_adresse_email) ;
|
||
write_csv_info( $dir_invoices, $invoice, $file_csv, $line_number, $line_csv ) ;
|
||
}
|
||
|
||
|
||
|
||
#print "==== $invoice $refund=================================================" ;
|
||
#print $email_message ;
|
||
|
||
my(
|
||
$clientAdrA,
|
||
$clientAdrB,
|
||
$clientAdrC,
|
||
$clientAdrD,
|
||
$clientAdrE,
|
||
$clientAdrF,
|
||
)
|
||
= build_address(
|
||
$Nom,
|
||
$Adresse_1,
|
||
$Adresse_2_district_quartier,
|
||
$Ville,
|
||
$Code_postal,
|
||
$Etat_Province,
|
||
$Pays,
|
||
) ;
|
||
|
||
foreach my $str (
|
||
$De_l_adresse_email,
|
||
$Nom,
|
||
$clientAdrA,
|
||
$clientAdrB,
|
||
$clientAdrC,
|
||
$clientAdrD,
|
||
$clientAdrE,
|
||
$clientAdrF,
|
||
) {
|
||
$str =~ s{#}{\\#}g ;
|
||
$str =~ s{_}{\\_}g ;
|
||
$str =~ s{&}{\\&}g ;
|
||
}
|
||
|
||
my ( $clientTypeEN, $clientTypeFR ) = client_type( $Nom_Option_1, $Valeur_Option_1 ) ;
|
||
|
||
my $quantity = '1' ;
|
||
|
||
my (
|
||
$descriptionFR,
|
||
$descriptionEN,
|
||
$usageFR,
|
||
$usageEN,
|
||
)
|
||
= description_stuff( $Titre_de_l_objet, $clientTypeEN ) ;
|
||
|
||
my (
|
||
$priceHT,
|
||
$tvaFR,
|
||
$tvaEN,
|
||
$priceTVA,
|
||
$priceTTC,
|
||
$messageTVAFR,
|
||
$messageTVAEN,
|
||
$priceTTCusd,
|
||
$HTorTTC
|
||
)
|
||
= tva_stuff( $clientTypeEN, $Pays, $Hors_taxe, $Devise, $Titre_de_l_objet ) ;
|
||
|
||
my $object_type = object_type( $Titre_de_l_objet ) ;
|
||
|
||
my ( $urlSrc, $urlExe ) = download_urls( $Date, $object_type ) ;
|
||
#print "ZZZ $object_type ( $urlSrc, $urlExe )\n" ;
|
||
|
||
my ( $Nom1 ) = cut( $Nom, 42 ) ;
|
||
|
||
my $clientVAT = '' ;
|
||
|
||
if ( ( 'VAT if professional in Europe' eq $Nom_Option_2 ) and $Option_2_Valeur ) {
|
||
$clientVAT = $Option_2_Valeur ;
|
||
}
|
||
|
||
my $tex_variables = qq{
|
||
%% Begin input from paypal_bilan $VERSION
|
||
\\providecommand{\\invoiceNumber}{$invoice}
|
||
\\providecommand{\\clientName}{$Nom1}
|
||
\\providecommand{\\clientEmail}{$De_l_adresse_email}
|
||
\\providecommand{\\clientAdrA}{$clientAdrA}
|
||
\\providecommand{\\clientAdrB}{$clientAdrB}
|
||
\\providecommand{\\clientAdrC}{$clientAdrC}
|
||
\\providecommand{\\clientAdrD}{$clientAdrD}
|
||
\\providecommand{\\clientAdrE}{$clientAdrE}
|
||
\\providecommand{\\clientAdrF}{$clientAdrF}
|
||
\\providecommand{\\clientVAT}{$clientVAT}
|
||
\\providecommand{\\invoiceDate}{$Date}
|
||
\\providecommand{\\invoiceHour}{$Heure}
|
||
|
||
\\providecommand{\\descriptionFR}{$descriptionFR}
|
||
\\providecommand{\\descriptionEN}{$descriptionEN}
|
||
\\providecommand{\\usageFR}{$usageFR}
|
||
\\providecommand{\\usageEN}{$usageEN}
|
||
\\providecommand{\\quantity}{$quantity}
|
||
|
||
\\providecommand{\\priceHT}{$priceHT}
|
||
\\providecommand{\\tvaFR}{$tvaFR}
|
||
\\providecommand{\\tvaEN}{$tvaEN}
|
||
\\providecommand{\\priceTVA}{$priceTVA}
|
||
\\providecommand{\\HTorTTC}{$HTorTTC}
|
||
\\providecommand{\\priceTTC}{$priceTTC}
|
||
\\providecommand{\\priceTTCusd}{$priceTTCusd}
|
||
\\providecommand{\\messageTVAFR}{$messageTVAFR}
|
||
\\providecommand{\\messageTVAEN}{$messageTVAEN}
|
||
\\providecommand{\\urlSrc}{\\url{$urlSrc}}
|
||
\\providecommand{\\urlExe}{\\url{$urlExe}}
|
||
%% End input from paypal_bilan
|
||
} ;
|
||
|
||
my $tex_variables_utf8 = to_utf8( { -string => $tex_variables, -charset => 'ISO-8859-1' } ) ;
|
||
|
||
print $tex_variables_utf8 if $debug_invoice_utf8 ;
|
||
print $tex_variables if $debug_invoice ;
|
||
|
||
#print "$invoice ", invoice_sent( $dir_invoices, $invoice, $De_l_adresse_email ), "\n" ;
|
||
if ( $write_invoices and ! invoice_sent( $dir_invoices, $invoice, $De_l_adresse_email ) ) {
|
||
write_tex_variables_file( $dir_invoices, $invoice, $Date, $tex_variables_utf8 ) ;
|
||
}
|
||
|
||
}
|
||
|
||
sub description_stuff {
|
||
my ( $object, $clientTypeEN ) = @_ ;
|
||
|
||
my $object_type = object_type( $object ) ;
|
||
|
||
my ( $descriptionFR, $descriptionEN ) ;
|
||
if ( 'software' eq $object_type ) {
|
||
$descriptionFR = 'Logiciel imapsync. Tous droits c<>d<EFBFBD>s.' ;
|
||
$descriptionEN = '(Imapsync software. All rights conceded.)' ;
|
||
}
|
||
|
||
my ( $usageFR, $usageEN ) ;
|
||
if ( 'professional' eq $clientTypeEN
|
||
and 'software' eq $object_type ) {
|
||
$usageFR = 'Usage <20> titre professionnel.' ;
|
||
$usageEN = '(professional usage.)' ;
|
||
}
|
||
|
||
if ( 'individual' eq $clientTypeEN
|
||
and 'software' eq $object_type ) {
|
||
$usageFR = 'Usage <20> titre individuel.' ;
|
||
$usageEN = '(individual usage.)' ;
|
||
}
|
||
|
||
if ( 'support' eq $object_type ) {
|
||
$descriptionFR = 'Support sur le logiciel imapsync.' ;
|
||
$descriptionEN = '(Imapsync support.)' ;
|
||
$usageFR = '' ;
|
||
$usageEN = '' ;
|
||
}
|
||
return( $descriptionFR, $descriptionEN, $usageFR, $usageEN ) ;
|
||
}
|
||
|
||
|
||
|
||
sub object_type {
|
||
my $object = shift ;
|
||
|
||
if ( 'imapsync' eq $object
|
||
or 'imapsync.exe' eq $object
|
||
or 'imapsync source' eq $object
|
||
or 'imapsync source code' eq $object
|
||
) {
|
||
return( 'software' ) ;
|
||
}elsif ( 'imapsync support' eq $object ) {
|
||
return( 'support' ) ;
|
||
}
|
||
}
|
||
|
||
sub build_email_message {
|
||
|
||
my ( $date, $name, $email, $invoice, $objet ) = @_ ;
|
||
|
||
my $object_type = object_type( $objet ) ;
|
||
|
||
my $message_header_software = qq{X-imapsync: invoice $invoice for imapsync software
|
||
From: Gilles LAMIRAL <gilles.lamiral\@laposte.net>
|
||
Bcc: gilles\@lamiral.info
|
||
Subject: [imapsync invoice] $invoice ($date) for imapsync software
|
||
Disposition-Notification-To: Gilles LAMIRAL <gilles.lamiral\@laposte.net>
|
||
} ;
|
||
|
||
my $message_header_support = qq{X-imapsync: invoice $invoice for imapsync support
|
||
From: Gilles LAMIRAL <gilles.lamiral\@laposte.net>
|
||
Bcc: gilles\@lamiral.info
|
||
Subject: [imapsync invoice] $invoice ($date) for imapsync support
|
||
Disposition-Notification-To: Gilles LAMIRAL <gilles.lamiral\@laposte.net>
|
||
} ;
|
||
|
||
my $message_body_software = qq{
|
||
Hello $name,
|
||
|
||
First of all, I'm sorry for the delay in getting back to you.
|
||
|
||
You'll find in the attachment the invoice of imapsync
|
||
software you bought and paid (dd/mm/yyyy $date).
|
||
The invoice file is named facture_imapsync-${invoice}.pdf
|
||
This invoice is in PDF format, ready to be print.
|
||
|
||
Should you need a hardcopy of this invoice,
|
||
I'll send it to you upon request by regular mail.
|
||
|
||
As the law requires, this numeric invoice PDF file
|
||
is signed with my private gpg key.
|
||
|
||
The resulting gpg signature is in the file named
|
||
facture_imapsync-${invoice}.pdf.asc
|
||
you will also find in the attachment.
|
||
|
||
You can check I (Gilles LAMIRAL) really did generate
|
||
this invoice with the following command line:
|
||
|
||
gpg --verify facture_imapsync-${invoice}.pdf.asc facture_imapsync-${invoice}.pdf
|
||
|
||
or any other gpg graphical tool.
|
||
|
||
Once more, thank you for buying and using imapsync.
|
||
|
||
Any feedback is welcome.
|
||
|
||
|
||
--
|
||
Best Regards, 09 51 84 42 42
|
||
Gilles Lamiral. France, Baulon (35580) 06 20 79 76 06
|
||
} ;
|
||
|
||
|
||
my $message_body_support = qq{
|
||
Hello $name,
|
||
|
||
First of all, I'm sorry for the delay in getting back to you.
|
||
|
||
You'll find in the attachment the invoice of imapsync
|
||
support you bought and paid (dd/mm/yyyy $date).
|
||
The invoice file is named facture_imapsync-${invoice}.pdf
|
||
This invoice is in PDF format, ready to be print.
|
||
|
||
Should you need a hardcopy of this invoice,
|
||
I'll send it to you upon request by regular mail.
|
||
|
||
As the law requires, this numeric invoice PDF file
|
||
is signed with my private gpg key.
|
||
|
||
The resulting gpg signature is in the file named
|
||
facture_imapsync-${invoice}.pdf.asc
|
||
you will also find in the attachment.
|
||
|
||
You can check I (Gilles LAMIRAL) really did generate
|
||
this invoice with the following command line:
|
||
|
||
gpg --verify facture_imapsync-${invoice}.pdf.asc facture_imapsync-${invoice}.pdf
|
||
|
||
or any other gpg graphical tool.
|
||
|
||
Once more, thank you for buying imapsync support.
|
||
|
||
Any feedback is welcome.
|
||
|
||
--
|
||
Best Regards, 09 51 84 42 42
|
||
Gilles Lamiral. France, Baulon (35580) 06 20 79 76 06
|
||
} ;
|
||
|
||
|
||
|
||
|
||
my $message_body_blabla = qq{
|
||
Here is the fingerprint of my public key
|
||
pub 1024D/FDA2B3DC 2002-05-08
|
||
Key fingerprint = 7906 F53D 0D62 0C67 304A 4CF0 6928 869B FDA2 B3DC
|
||
uid Gilles LAMIRAL <gilles.lamiral\@laposte.net>
|
||
sub 1024g/A2C4CB42 2002-05-08
|
||
|
||
Of course the verification doesn't prove anything until
|
||
all the following conditions are met:
|
||
- you met me,
|
||
- I agree that the fingerprint above is really mine
|
||
- I prove I'm Gilles LAMIRAL with an official paper.
|
||
|
||
Normally we won't have to verify anything unless
|
||
I disagree with this invoice and the payment
|
||
you made for imapsync.
|
||
} ;
|
||
|
||
my ( $message_header, $message_body ) ;
|
||
if ( 'support' eq $object_type ) {
|
||
$message_header = $message_header_support ;
|
||
$message_body = $message_body_support ;
|
||
}elsif ( 'software' eq $object_type ) {
|
||
$message_header = $message_header_software ;
|
||
$message_body = $message_body_software ;
|
||
}
|
||
return( $message_header, $message_body ) ;
|
||
|
||
}
|
||
|
||
sub write_csv_info {
|
||
|
||
my( $dir_invoices, $invoice, $file_csv, $line_number, $line_csv ) = @_ ;
|
||
|
||
open( CSVINFO, "> $dir_invoices/$invoice/csv_info.txt") or die ;
|
||
print CSVINFO join( "\n", $file_csv, $line_number, $line_csv ) ;
|
||
close( CSVINFO ) ;
|
||
|
||
}
|
||
|
||
sub invoice_sent {
|
||
|
||
my ( $dir_invoices, $invoice, $email_address ) = @_ ;
|
||
|
||
return( 1 ) if ( -f "$dir_invoices/$invoice/SENT_TO_$email_address" ) ;
|
||
return( 0 ) ;
|
||
|
||
}
|
||
|
||
sub write_email_message {
|
||
my ( $dir_invoices, $invoice, $message_header, $message_body, $email_address ) = @_ ;
|
||
|
||
my $message_body_utf8 = to_utf8({ -string => $message_body, -charset => 'ISO-8859-1' });
|
||
|
||
mkdir( "$dir_invoices/$invoice" ) or die if ! -d "$dir_invoices/$invoice" ;
|
||
|
||
open( HEADER, "> $dir_invoices/$invoice/facture_message_header.txt") or die ;
|
||
print HEADER $message_header ;
|
||
close( HEADER ) ;
|
||
|
||
open( BODY, "> $dir_invoices/$invoice/facture_message_body.txt") or die ;
|
||
print BODY $message_body_utf8 ;
|
||
close( BODY ) ;
|
||
|
||
open( ADDRESS, "> $dir_invoices/$invoice/email_address.txt") or die ;
|
||
print ADDRESS "$email_address\n" ;
|
||
close( ADDRESS ) ;
|
||
}
|
||
|
||
|
||
sub write_tex_variables_file {
|
||
my ( $dir_invoices, $invoice, $date_jjSmmSaaaa, $tex_variables_utf8 ) = @_ ;
|
||
|
||
mkdir( "$dir_invoices/$invoice" ) or die if ! -d "$dir_invoices/$invoice" ;
|
||
open( FILE, "> $dir_invoices/$invoice/imapsync_var.tex") or die ;
|
||
print FILE $tex_variables_utf8 ;
|
||
close( FILE ) ;
|
||
|
||
if ( ! -f "$dir_invoices/$invoice/imapsync_var_manual.tex" ) {
|
||
open( FILE, "> $dir_invoices/$invoice/imapsync_var_manual.tex") or die ;
|
||
print FILE "%% $0 created file
|
||
%% Can be used to override imapsync_var.tex definitions\n" ;
|
||
print FILE $tex_variables_utf8 ;
|
||
close( FILE ) ;
|
||
}
|
||
|
||
}
|
||
|
||
sub download_urls {
|
||
my $date_jjSmmSaaaa = shift ;
|
||
my $object_type = shift ;
|
||
|
||
my $date_aaaa_mm_jj = date_aaaa_mm_jj( $date_jjSmmSaaaa ) ;
|
||
#print "$date_aaaa_mm_jj $date_jjSmmSaaaa $object_type\n" ;
|
||
my ( $urlSrc, $urlExe ) ;
|
||
|
||
if ('2011_05_01' le $date_aaaa_mm_jj
|
||
and 'software' eq $object_type ) {
|
||
$urlSrc = 'http://ks.lamiral.info/imapsync/paypal_return.shtml' ;
|
||
$urlExe = '' ;
|
||
return( $urlSrc, $urlExe ) ;
|
||
}
|
||
|
||
if ('2011_05_01' le $date_aaaa_mm_jj
|
||
and 'support' eq $object_type ) {
|
||
$urlSrc = 'http://ks.lamiral.info/imapsync/paypal_return_support.shtml' ;
|
||
$urlExe = '' ;
|
||
return( $urlSrc, $urlExe ) ;
|
||
}
|
||
|
||
if ('2011_03_24' le $date_aaaa_mm_jj) {
|
||
$urlSrc = 'http://www.linux-france.org/prj/imapsync/paypal_return.shtml' ;
|
||
$urlExe = '' ;
|
||
return( $urlSrc, $urlExe ) ;
|
||
}
|
||
if ('2011_02_21' le $date_aaaa_mm_jj) {
|
||
$urlSrc = 'http://www.linux-france.org/depot/2011_02_21/OUMbo7/' ;
|
||
$urlExe = 'http://www.linux-france.org/depot/2011_02_21/rHSVNs/' ;
|
||
return( $urlSrc, $urlExe ) ;
|
||
}
|
||
if ('2011_01_18' le $date_aaaa_mm_jj) {
|
||
$urlSrc = 'http://www.linux-france.org/depot/2011_01_18/zPRRNt/' ;
|
||
$urlExe = 'http://www.linux-france.org/depot/2011_01_18/FO1QzG/' ;
|
||
return( $urlSrc, $urlExe ) ;
|
||
}
|
||
if ('2011_01_18' le $date_aaaa_mm_jj) {
|
||
$urlSrc = 'http://www.linux-france.org/depot/2010_11_28/SiNdlZ/' ;
|
||
$urlExe = 'http://www.linux-france.org/depot/2010_11_28/R3ZAyr/' ;
|
||
return( $urlSrc, $urlExe ) ;
|
||
}
|
||
$urlSrc = 'http://www.linux-france.org/depot/2010_11_08/X2PWMe/' ;
|
||
$urlExe = 'http://www.linux-france.org/depot/2010_11_08/ZZ7zSc/' ;
|
||
return( $urlSrc, $urlExe ) ;
|
||
}
|
||
|
||
sub date_aaaa_mm_jj {
|
||
my $date_jjSmmSaaaa = shift ;
|
||
|
||
if ( $date_jjSmmSaaaa =~ m{(\d\d)/(\d\d)/(\d\d\d\d)} ) {
|
||
my( $jj, $mm, $aaaa ) = ( $1, $2, $3 ) ;
|
||
return( join( '_', $aaaa, $mm, $jj ) ) ;
|
||
}else{
|
||
return( '9999_12_31' ) ;
|
||
}
|
||
}
|
||
|
||
|
||
sub tva_line {
|
||
my( $Devise, $Montant2, $Pays, $Nom_Option_1, $Valeur_Option_1, $Titre_de_l_objet ) = @_ ;
|
||
my( $montant_HT_EUR_exo, $montant_HT_EUR_ass, $montant_TVA_EUR ) = ( 0, 0, 0 ) ;
|
||
|
||
my( $montant_HT_EUR_sup, $montant_TVA_EUR_sup ) = ( 0, 0 ) ;
|
||
|
||
$Montant2 = $Montant2/$usdeur if 'USD' eq $Devise ;
|
||
|
||
if ( 'imapsync' eq $Titre_de_l_objet
|
||
or 'imapsync.exe' eq $Titre_de_l_objet
|
||
or 'imapsync source' eq $Titre_de_l_objet
|
||
or 'imapsync source code' eq $Titre_de_l_objet
|
||
|
||
) {
|
||
if (
|
||
( 'imapsync usage' eq $Nom_Option_1 and 'individual' eq $Valeur_Option_1 )
|
||
or
|
||
( 'France' eq $Pays )
|
||
) {
|
||
$montant_HT_EUR_ass = $Montant2 / 1.196 ;
|
||
$montant_TVA_EUR = $Montant2 / 1.196 * 0.196 ;
|
||
$debug_dev and print "$Montant2 $Pays $Valeur_Option_1\n" ;
|
||
}else{
|
||
$montant_HT_EUR_exo = $Montant2 ;
|
||
}
|
||
}
|
||
|
||
if ( 'imapsync support' eq $Titre_de_l_objet ) {
|
||
#print "ZZZZ $Titre_de_l_objet $Montant2\n" ;
|
||
$montant_HT_EUR_sup = $Montant2 / 1.196 ;
|
||
$montant_TVA_EUR_sup = $Montant2 / 1.196 * 0.196 ;
|
||
}
|
||
|
||
|
||
return( $montant_HT_EUR_exo, $montant_HT_EUR_ass, $montant_TVA_EUR, $montant_HT_EUR_sup, $montant_TVA_EUR_sup ) ;
|
||
}
|
||
|
||
|
||
|
||
sub tva_stuff {
|
||
my( $clientTypeEN, $Pays, $Hors_taxe, $Devise, $Titre_de_l_objet ) = @_ ;
|
||
|
||
my $priceTTCusd = '' ;
|
||
$Hors_taxe =~ s{,}{.} ;
|
||
|
||
if ( $Devise eq 'USD' ) {
|
||
$priceTTCusd = "(usd $Hors_taxe)" ;
|
||
$Hors_taxe = ( $Hors_taxe/$usdeur ) ;
|
||
}
|
||
|
||
my (
|
||
$priceHT,
|
||
$tvaFR,
|
||
$tvaEN,
|
||
$priceTVA,
|
||
$priceTTC,
|
||
$messageTVAFR,
|
||
$messageTVAEN,
|
||
$HTorTTC
|
||
) ;
|
||
|
||
if ( ( 'individual' eq $clientTypeEN)
|
||
or
|
||
( 'France' eq $Pays )
|
||
or
|
||
( 'imapsync support' eq $Titre_de_l_objet )
|
||
) {
|
||
$priceHT = sprintf('%2.2f', $Hors_taxe/1.196) ;
|
||
$tvaFR = '19,60\%';
|
||
$tvaEN = '';
|
||
$priceTVA = sprintf('%2.2f', $Hors_taxe/1.196*0.196) ;
|
||
$priceTTC = sprintf('%2.2f', $Hors_taxe) ;
|
||
$HTorTTC = 'TTC' ;
|
||
$messageTVAFR = '' ;
|
||
$messageTVAEN = '' ;
|
||
}else{
|
||
$priceHT = sprintf('%2.2f', $Hors_taxe) ;
|
||
$tvaFR = '' ;
|
||
$tvaEN = '' ;
|
||
$priceTVA = 'n<>ant (none)' ;
|
||
$priceTTC = $priceHT ;
|
||
$HTorTTC = 'HT' ;
|
||
$messageTVAFR = 'Exon<6F>ration de TVA, articles 262 1-2 et ter du Code G<>n<EFBFBD>ral des Imp<6D>ts';
|
||
$messageTVAEN = '(VAT tax-exempt, articles 262 1-2 and ter of French General Tax Code)';
|
||
}
|
||
foreach my $price ( $priceHT, $priceTVA, $priceTTC, $priceTTCusd ) {
|
||
#print "[$price]\n" ;
|
||
$price =~ s{\.}{, } ;
|
||
}
|
||
return(
|
||
$priceHT,
|
||
$tvaFR,
|
||
$tvaEN,
|
||
$priceTVA,
|
||
$priceTTC,
|
||
$messageTVAFR,
|
||
$messageTVAEN,
|
||
$priceTTCusd,
|
||
$HTorTTC
|
||
) ;
|
||
}
|
||
|
||
sub client_type {
|
||
my ( $Nom_Option_1, $Valeur_Option_1 ) = @_ ;
|
||
|
||
my ( $clientTypeEN, $clientTypeFR ) = ( 'professional', 'professionnel' ) ;
|
||
|
||
if ('imapsync usage' eq $Nom_Option_1 and 'individual' eq $Valeur_Option_1 ) {
|
||
$clientTypeEN = 'individual' ;
|
||
$clientTypeFR = 'individuel' ;
|
||
}elsif ('imapsync usage' eq $Nom_Option_1 and 'professional' eq $Valeur_Option_1 ) {
|
||
$clientTypeEN = 'professional' ;
|
||
$clientTypeFR = 'professionnel' ;
|
||
}
|
||
return( $clientTypeEN, $clientTypeFR ) ;
|
||
}
|
||
|
||
sub build_address {
|
||
my(
|
||
$Nom,
|
||
$Adresse_1,
|
||
$Adresse_2_district_quartier,
|
||
$Ville,
|
||
$Code_postal,
|
||
$Etat_Province,
|
||
$Pays,
|
||
) = @_ ;
|
||
|
||
my $addr = "
|
||
===========================================================
|
||
Nom $Nom
|
||
Adresse_1 $Adresse_1
|
||
Adresse_2_district_quartier $Adresse_2_district_quartier
|
||
Ville Code_postal $Ville $Code_postal
|
||
Etat_Province $Etat_Province
|
||
Pays $Pays
|
||
" ;
|
||
#print $addr ;
|
||
|
||
my @address ;
|
||
$Nom = '' if ( $Nom =~ m/^\s+$/ ) ;
|
||
my( $Nom1, $Nom2 ) = cut( $Nom, 42 ) ;
|
||
push( @address, $Nom1 ) if $Nom1 ;
|
||
#push( @address, $Nom2 ) if $Nom2 ;
|
||
push( @address, $Adresse_1 ) if $Adresse_1 ;
|
||
push( @address, $Adresse_2_district_quartier ) if $Adresse_2_district_quartier ;
|
||
push( @address, "$Ville $Code_postal" ) if ( $Ville or $Code_postal );
|
||
push( @address, $Etat_Province ) if $Etat_Province ;
|
||
push( @address, $Pays, ) if $Pays ;
|
||
|
||
|
||
my $clientAdrA = shift( @address ) || '' ;
|
||
my $clientAdrB = shift( @address ) || '' ;
|
||
my $clientAdrC = shift( @address ) || '' ;
|
||
my $clientAdrD = shift( @address ) || '' ;
|
||
my $clientAdrE = shift( @address ) || '' ;
|
||
my $clientAdrF = shift( @address ) || '' ;
|
||
|
||
$addr = "
|
||
[$clientAdrA]
|
||
[$clientAdrB]
|
||
[$clientAdrC]
|
||
[$clientAdrD]
|
||
[$clientAdrE]
|
||
[$clientAdrF]
|
||
";
|
||
#print $addr ;
|
||
|
||
return(
|
||
$clientAdrA,
|
||
$clientAdrB,
|
||
$clientAdrC,
|
||
$clientAdrD,
|
||
$clientAdrE,
|
||
$clientAdrF,
|
||
) ;
|
||
}
|
||
|
||
|
||
sub half {
|
||
my $string = shift ;
|
||
my $half = int( lenght( $string ) / 2 ) ;
|
||
# TO BE DONE
|
||
|
||
}
|
||
|
||
sub tests_half {
|
||
my( $aa, $bb ) = half( 'aa bb' ) ;
|
||
ok( 'aa' eq $aa, 'half: aa' ) ;
|
||
ok( 'bb' eq $bb, 'half: bb' ) ;
|
||
}
|
||
|
||
sub cut {
|
||
my $string = shift ;
|
||
my $offset = shift ;
|
||
|
||
return( $string, '' ) if length( $string ) < $offset ;
|
||
my $first = substr( $string, 0, $offset ) ;
|
||
my $last = substr( $string, $offset ) ;
|
||
return( $first, $last ) ;
|
||
}
|
||
|
||
sub tests_cut {
|
||
my( $aa, $bb ) = cut("123456789", 4 ) ;
|
||
ok( '1234' eq $aa, 'cut 123456789 4 => first 1234' ) ;
|
||
ok( '56789' eq $bb, 'cut 123456789 4 => last 56789' ) ;
|
||
}
|