#!/usr/bin/perl # $Id: paypal_bilan,v 1.72 2014/01/18 01:38:35 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.72 2014/01/18 01:38:35 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_HT_EUR_sup_exo = 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 $dry ; 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, 'dry' => \$dry, '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_invoice ; my %invoice_paypal ; 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" ; my @actions ; foreach my $file ( @files ) { my @actions_file = parse_file( $file ) ; push( @actions, @actions_file ) ; } foreach my $action (@actions) { # compute_line() adds $action->{ 'invoice' } if needed compute_line( $action ) ; # index by invoice number $action_invoice{ $action->{ 'invoice' } } = $action ; } delete $action_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_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 ) if ( $debug_invoice or $debug_invoice_utf8 ) ; }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_HT_EUR_sup_exo = sprintf('%2.2f', $total_HT_EUR_sup_exo) ; $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 "EUR total HT sup exo $total_HT_EUR_sup_exo\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 + $total_HT_EUR_sup_exo ; $total_eur2 = sprintf('%2.2f', $total_eur2) ; print "$total_eur != $total_eur2 = $total_HT_EUR_exo + $total_HT_EUR_ass + $total_TVA_EUR + $total_HT_EUR_sup + $total_TVA_EUR_sup + $total_HT_EUR_sup_exo\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 invoice_00000 { my $invoice = shift ; return( sprintf( "%04d", $invoice ) ) ; } sub tests_invoice_00000 { ok( '0000' eq invoice_00000( 0 ), 'invoice_00000: 0 -> 0000' ) ; ok( '0147' eq invoice_00000( 147 ), 'invoice_00000: 147 -> 0147' ) ; ok( '99999' eq invoice_00000( 99999 ), 'invoice_00000: 99999 -> 99999' ) ; } 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_exportbnc { ok( 1 == 1, '1 == 1' ) ; } sub tests { tests_next_invoice( ) ; tests_cut( ) ; tests_invoice_00000( ) ; #tests_exportbnc( ) ; tests_tva_rate( ) ; tests_tva_rate_str( ) ; } sub compute_line { my $action = shift ; my %action = %$action ; my( $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, $Nom_Option_2, $Option_2_Valeur, $Impact_sur_le_solde ) = @action{ ( 'Date', 'Heure', 'Fuseau horaire', 'Nom', 'Type', 'Etat', 'Devise', 'Montant', "Numé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', 'Impact sur le solde') } ; #print "[$Option_2_Valeur] [$Impact_sur_le_solde]\n" ; #next; ( $Etat ) = @action{ ( 'Etat' ) } || @action{ ( 'État' ) } ; ( $Hors_taxe_paypal ) = @action{ ( 'Hors taxe' ) } || @action{ ( 'Avant commission' ) } ; $Impact_sur_le_solde ||= '' ; my $invoice = 'NONE' ; $Montant = $action->{ 'Net' } if not defined $Montant; $debug and print( "#" x 78, "\n", "[$Date] [$Heure] [$Fuseau_horaire] [$Nom] [$Type] [$Etat] ", "[$Devise] [$Hors_taxe_paypal] [$Montant] [$Numero_davis_de_reception] [$Solde] [$Impact_sur_le_solde] ", "[$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, $montant_HT_EUR_sup_exo ) ; 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] [$Impact_sur_le_solde]\n", "[$Pays] [$Nom_Option_1] [$Valeur_Option_1] [$Titre_de_l_objet]\n" ) ; } if ( 'Paiement sur site marchand reçu' eq $Type and 'USD' eq $Devise and ( 'Terminé' eq $Etat or 'Compensé' 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, $montant_HT_EUR_sup_exo ) = tva_line( $Devise, $Montant2_usd, $Pays, $Nom_Option_1, $Valeur_Option_1, $Titre_de_l_objet, $Date ) ; $total_HT_EUR_exo += $montant_HT_EUR_exo ; $total_HT_EUR_ass += $montant_HT_EUR_ass ; $total_TVA_EUR += $montant_TVA_EUR ; $invoice = next_invoice( ) ; $nb_invoice++ ; $print_details and print ( "[$invoice] [$Date] [$Heure] [$Fuseau_horaire] [$Nom] [$Type] [$Etat] [$Devise] [$Montant] [$Numero_davis_de_reception] [$Solde] [$Impact_sur_le_solde]\n" ) ; } if ( 'Paiement sur site marchand reçu' eq $Type and 'EUR' eq $Devise and ( 'Terminé' eq $Etat or 'Compensé' 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, $montant_HT_EUR_sup_exo ) = tva_line( $Devise, $Montant2_eur, $Pays, $Nom_Option_1, $Valeur_Option_1, $Titre_de_l_objet, $Date ) ; $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 ; $total_HT_EUR_sup_exo += $montant_HT_EUR_sup_exo ; $invoice = next_invoice( ) ; $nb_invoice++ ; $print_details and print ( "[$invoice] [$Date] [$Heure] [$Fuseau_horaire] [$Nom] [$Type] [$Etat] [$Devise] [$Montant] [$Numero_davis_de_reception] [$Solde] [$Impact_sur_le_solde]\n" ) ; } if ( 'Paiement sur site marchand reçu' eq $Type and 'EUR' eq $Devise and 'Remboursé' 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] [$Impact_sur_le_solde]\n" ) ; } if ( 'Paiement sur site marchand reçu' eq $Type and 'EUR' eq $Devise and 'Annulé' 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] [$Impact_sur_le_solde]\n" ) ; } if ( 'Paiement sur site marchand reç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] [$Impact_sur_le_solde]\n" ) ; } if ( 'Paiement sur site marchand reçu' eq $Type and 'EUR' eq $Devise and 'Non compensé' 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] [$Impact_sur_le_solde]\n" ) ; } $action->{ 'invoice' } = $invoice ; if ( $bnc ) { my $FR_flag = FR_flag( $Pays ) ; my $IND_flag = IND_flag( $Nom_Option_1, $Valeur_Option_1 ) ; my $SUPPORT_flag = SUPPORT_flag( $Titre_de_l_objet ) ; my $BNC_output = BNC_output( $invoice, $FR_flag, $IND_flag, $SUPPORT_flag, $Nom, $Date, $MontantEUR, $Devise, $Titre_de_l_objet, $Impact_sur_le_solde, $Type ) ; print $BNC_output ; } } sub BNC_output { # FE 1359 FR IND imapsync Bougon Edouard # [12/01/2012] FR IND 28.73 EUR my( $invoice, $FR_flag, $IND_flag, $SUPPORT_flag, $Nom, $Date, $MontantEUR, $Devise, $Titre_de_l_objet, $Impact_sur_le_solde, $Type ) = @_ ; my $BNC_output ; if ( 'NONE' eq $invoice ) { $BNC_output = "[$Date] $MontantEUR $Devise $Nom $Titre_de_l_objet [$Impact_sur_le_solde] [$Type]\n" ; }else{ $BNC_output = "FE $invoice$FR_flag$IND_flag imapsync$SUPPORT_flag $Nom\n" . "[$Date]$FR_flag$IND_flag $MontantEUR $Devise \n" ; } return( $BNC_output ) ; } sub SUPPORT_flag { my $Titre_de_l_objet = shift ; my $SUPPORT_flag = '' ; $SUPPORT_flag = ' support' if ( 'imapsync support' eq $Titre_de_l_objet ) ; } sub IND_flag { my( $Nom_Option_1, $Valeur_Option_1 ) = @_ ; my $IND_flag = '' ; $IND_flag = ' IND' if ('imapsync usage' eq $Nom_Option_1 and 'individual' eq $Valeur_Option_1 ) ; return( $IND_flag ) ; } sub FR_flag { my $Pays = shift ; my $FR_flag = '' ; $FR_flag = ' FR' if $Pays eq 'France' ; return( $FR_flag ) ; } sub build_invoice { my $invoice = shift ; return if ! $invoice ; my $action = $action_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érence', 'Adresse 1', 'Adresse 2/district/quartier', 'Ville', 'Etat/Province/Région/Comté/Territoire/Préfecture/République', 'Code postal', 'Pays', 'line_number', 'line_csv', 'file_csv', 'Nom Option 2', 'Option 2 Valeur' ) } ; $Etat_Province = @action{ ( 'Etat/Province/Région/Comté/Territoire/Préfecture/République' ) } || @action{ ( 'État/Province/Région/Comté/Territoire/Préfecture/République' ) } || '' ; ( $Hors_taxe ) = @action{ ( 'Hors taxe' ) } || @action{ ( 'Avant commission' ) } ; #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, $Date ) ; 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' } ) ; $debug_invoice_utf8 and print $tex_variables_utf8 ; $debug_invoice and print $tex_variables ; #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és, autorisés.' ; $descriptionEN = '(Imapsync software. ALL rights conceded, allowed.)' ; } my ( $usageFR, $usageEN ) ; if ( 'professional' eq $clientTypeEN and 'software' eq $object_type ) { $usageFR = 'Usage à titre professionnel.' ; $usageEN = '(professional usage.)' ; } if ( 'individual' eq $clientTypeEN and 'software' eq $object_type ) { $usageFR = 'Usage à 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 Bcc: gilles\@lamiral.info Subject: [imapsync invoice] $invoice ($date) for imapsync software Disposition-Notification-To: Gilles LAMIRAL } ; my $message_header_support = qq{X-imapsync: invoice $invoice for imapsync support From: Gilles LAMIRAL Bcc: gilles\@lamiral.info Subject: [imapsync invoice] $invoice ($date) for imapsync support Disposition-Notification-To: Gilles LAMIRAL } ; my $message_body_software = qq{ Hello $name, First of all, I'm sorry for the delay in getting back to you. Last imapsync release is available from the page http://imapsync.lamiral.info/paypal_return.shtml 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. Last imapsync release is available from the page http://imapsync.lamiral.info/paypal_return.shtml 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 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 ) = @_ ; my $invoice_00000 = invoice_00000( $invoice ) ; $debug and print "Writing $dir_invoices/$invoice_00000/csv_info.txt\n" ; $dry and return( ) ; open( CSVINFO, "> $dir_invoices/$invoice_00000/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 ) = @_ ; my $invoice_00000 = invoice_00000( $invoice ) ; return( 1 ) if ( -f "$dir_invoices/$invoice_00000/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' }); my $invoice_00000 = invoice_00000( $invoice ) ; if ( ! -d "$dir_invoices/$invoice_00000" ) { $debug and print "mkdir $dir_invoices/$invoice_00000\n" ; $dry or mkdir( "$dir_invoices/$invoice_00000" ) or die ; } $dry and return( ) ; open( HEADER, "> $dir_invoices/$invoice_00000/facture_message_header.txt") or die ; print HEADER $message_header ; close( HEADER ) ; open( BODY, "> $dir_invoices/$invoice_00000/facture_message_body.txt") or die ; print BODY $message_body_utf8 ; close( BODY ) ; open( ADDRESS, "> $dir_invoices/$invoice_00000/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 ) = @_ ; my $invoice_00000 = invoice_00000( $invoice ) ; if ( ! -d "$dir_invoices/$invoice_00000" ) { $debug and print "mkdir $dir_invoices/$invoice_00000\n" ; $dry or mkdir( "$dir_invoices/$invoice_00000" ) or die ; } $debug and print "Writing imapsync_var.tex $dir_invoices/$invoice_00000/imapsync_var.tex\n" ; $dry and return( ) ; open( FILE, "> $dir_invoices/$invoice_00000/imapsync_var.tex") or die ; print FILE $tex_variables_utf8 ; close( FILE ) ; if ( ! -f "$dir_invoices/$invoice_00000/imapsync_var_manual.tex" ) { open( FILE, "> $dir_invoices/$invoice_00000/imapsync_var_manual.tex") or die ; print FILE "%% $0 created this 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_rate { my $date_aaaa_mm_jj = shift ; if ( '2014_01_01' gt $date_aaaa_mm_jj ) { #print "tva_rate 0.196\n" ; #return( 0 ) ; return( 0.196 ) ; } if ( '2014_01_01' le $date_aaaa_mm_jj ) { #print "tva_rate 0.2\n" ; return( 0.2 ) ; } #print "tva_rate 0\n" ; return( 0 ) ; } sub tests_tva_rate { ok( 0.196 == tva_rate( '2013_01_01' ), 'tva_rate: old 0.196' ) ; ok( 0.196 == tva_rate( '2013_12_31' ), 'tva_rate: old 0.196' ) ; ok( 0.2 == tva_rate( '2014_01_01' ), 'tva_rate: new 0.2' ) ; ok( 0.2 == tva_rate( '2014_12_31' ), 'tva_rate: new 0.2' ) ; ok( 0.2 == tva_rate( '2050_01_01' ), 'tva_rate: new 0.2' ) ; ok( 0.2 == tva_rate( '2050_12_31' ), 'tva_rate: new 0.2' ) ; return( 0 ) ; } sub tva_rate_str { my $date_aaaa_mm_jj = shift ; if ( '2014_01_01' gt $date_aaaa_mm_jj ) { #print "tva_rate 0.196\n" ; return( '19,60\%' ) ; } if ( '2014_01_01' le $date_aaaa_mm_jj ) { return( '20\%' ) ; } #print "tva_rate 0\n" ; return( '' ) ; } sub tests_tva_rate_str { ok( '19,60\%' eq tva_rate_str( '2013_01_01' ), 'tva_rate_str: old 0.196' ) ; ok( '19,60\%' eq tva_rate_str( '2013_12_31' ), 'tva_rate_str: old 0.196' ) ; ok( '20,00\%' eq tva_rate_str( '2014_01_01' ), 'tva_rate_str: new 0.2' ) ; ok( '20,00\%' eq tva_rate_str( '2014_12_31' ), 'tva_rate_str: new 0.2' ) ; ok( '20,00\%' eq tva_rate_str( '2050_01_01' ), 'tva_rate_str: new 0.2' ) ; ok( '20,00\%' eq tva_rate_str( '2050_12_31' ), 'tva_rate_str: new 0.2' ) ; return( 0 ) ; } sub tva_line { my( $Devise, $Montant2, $Pays, $Nom_Option_1, $Valeur_Option_1, $Titre_de_l_objet, $Date ) = @_ ; my( $montant_HT_EUR_exo, $montant_HT_EUR_ass, $montant_TVA_EUR ) = ( 0, 0, 0 ) ; my( $montant_HT_EUR_sup, $montant_TVA_EUR_sup, $montant_HT_EUR_sup_exo ) = ( 0, 0, 0 ) ; my $date_aaaa_mm_jj = date_aaaa_mm_jj( $Date ) ; $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 + tva_rate( $date_aaaa_mm_jj ) ) ; $montant_TVA_EUR = $Montant2 / ( 1 + tva_rate( $date_aaaa_mm_jj ) ) * tva_rate( $date_aaaa_mm_jj ) ; $debug_dev and print "$Montant2 $Pays $Valeur_Option_1\n" ; }else{ $montant_HT_EUR_exo = $Montant2 ; } } if ( 'imapsync support' eq $Titre_de_l_objet ) { if ( ( 'imapsync usage' eq $Nom_Option_1 and 'individual' eq $Valeur_Option_1 ) or ( 'France' eq $Pays ) or ( '2013_02_19' gt $date_aaaa_mm_jj ) ) { $montant_HT_EUR_sup = $Montant2 / ( 1 + tva_rate( $date_aaaa_mm_jj ) ) ; $montant_TVA_EUR_sup = $Montant2 / ( 1 + tva_rate( $date_aaaa_mm_jj ) ) * tva_rate( $date_aaaa_mm_jj ) ; }else{ $montant_HT_EUR_sup_exo = $Montant2 ; } } return( $montant_HT_EUR_exo, $montant_HT_EUR_ass, $montant_TVA_EUR, $montant_HT_EUR_sup, $montant_TVA_EUR_sup, $montant_HT_EUR_sup_exo ) ; } sub tva_stuff { my( $clientTypeEN, $Pays, $Hors_taxe, $Devise, $Titre_de_l_objet, $Date ) = @_ ; my $priceTTCusd = '' ; $Hors_taxe =~ s{,}{.} ; my $date_aaaa_mm_jj = date_aaaa_mm_jj( $Date ) ; 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 ) ) { $priceHT = sprintf('%2.2f', $Hors_taxe / ( 1 + tva_rate( $date_aaaa_mm_jj ) ) ) ; $tvaFR = tva_rate_str( $date_aaaa_mm_jj ) ; $tvaEN = '' ; $priceTVA = sprintf('%2.2f', $Hors_taxe / ( 1 + tva_rate( $date_aaaa_mm_jj ) ) * tva_rate( $date_aaaa_mm_jj ) ) ; $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ération de TVA, articles 259 et 262 du Code Général des Impôts'; $messageTVAEN = '(VAT tax-exempt, articles 259 and 262 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 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' ) ; }