#!/usr/bin/perl -w
#
#  File:         sl02-cli-example.pl
#  Environment:  SQL-Ledger 2.4.0+, LedgerSMB 1.2.11
#  Author:       Louis B. Moore
#
#  Copyright (C)   2005  Louis B. Moore
#                  2008  Antoine Beaupré
#
#  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.
#
#

use LWP::UserAgent;
use HTTP::Cookies;
use HTML::Entities;

$base = "https://lethe.koumbit.net/ledgersmb/";

print "\n\nSQL-Ledger login: ";
my $login = <STDIN>;
chomp($login);


print "\nSQL-Ledger password: ";
system("stty -echo");
my $pwd = <STDIN>;
system("stty echo");
chomp($pwd);
print "\n\n";

my $ua = LWP::UserAgent->new( agent => 'LedgerSMB CLI client' );

$ua->cookie_jar( HTTP::Cookies->new() );

$cmd = "login=" . $login . '&password=' . $pwd . '&path=bin/lynx&action=login';

$rc = runSLcmd($ua, "login.pl", $cmd);

if ( $rc =~ m/Denied/) {

    print "\nLogin error\n";
    exit;

}

print "Login successful\n";

while (<main::DATA>) {

    chomp;
    @rec = split(/\|/);

    $arg = 'path=bin/lynx&login=' . $login . '&password=' . $pwd .
	'&action='       . escape(substr($rec[0],0,35)) .
 	'&db='           . $rec[1] .
 	'&name='         . escape(substr($rec[2],0,35)) .
 	'&address1='     . escape(substr($rec[3],0,35)) .
 	'&address2='     . escape(substr($rec[4],0,35)) .
 	'&city='         . escape(substr($rec[5],0,35)) .
 	'&state='        . escape(substr($rec[6],0,35)) .
 	'&zipcode='      . escape(substr($rec[7],0,35)) .
 	'&country='      . escape(substr($rec[8],0,35)) .
 	'&phone='        . escape(substr($rec[9],0,20)) .
 	'&taxincluded=0' .
 	'&terms=0';
    $arg .= '&tax_2310=1'; # TPS
    $arg .= '&tax_2320=1'; # TVQ
    $arg .= '&taxaccounts=2310 2320 2330';
    #$arg .= '&tax_2330=1'; # TVH
 
    $rc=runSLcmd($ua, "ct.pl",$arg);

    if ($rc =~ m/saved!/) {

	print "$rec[2] SAVED\n";
 
    } else {
 
	print "$rec[2] ERROR\n";
	print $rc;
 
    }
 
}


$cmd = "login=" . $login . '&password=' . $pwd . '&path=bin/mozilla/&action=logout';

$signin = runSLcmd($ua, "login.pl",$cmd);

if ( $signin =~ m/Error:/ ) {

    print "\nLogout error\n";

}

exit;


#*******************************************************
# Subroutines
#*******************************************************


sub runSLcmd {

    my $ua = shift;
    my $cmd  = shift;
    my $args = shift;
    my $i    = 0;
    my $results;

    my $req = HTTP::Request->new( GET => $base . $cmd . '?' . $args);
    my $res = $ua->request($req);
    die $res->status_line if not $res->is_success;

    return $res->content;

}

sub escape {

    my $str = shift;

    if ($str) {

	decode_entities($str);
	$str =~ s/([^a-zA-Z0-9_.-])/sprintf("%%%02x", ord($1))/ge;

    }
 
    return $str;
 
}
 
 
#*******************************************************
# Record Format
#*******************************************************
#
# action | db | name | address1 | address2 | city | state | zipcode | country | phone
#
# exemple:
# save|vendor|Parts are Us|238 Riverview|Suite 11|Cheese Head|WI|56743|USA|555-123-3322|
# save|vendor|Widget Heaven|41 S. Riparian Way||Show Me|MO|39793|USA|555-231-3309|
# save|vendor|Consolidated Spackle|1010 Binary Lane|Dept 1101|Beverly Hills|CA|90210|USA|555-330-7639 x772|
# save|customer|Consolidated Spackle|1010 Binary Lane|Dept 1101|Beverly Hills|CA|90210|USA|555-330-7639 x772|
__END__
save|customer|Consolidated Spackle|1010 Binary Lane|Dept 1101|Beverly Hills|CA|90210|USA|555-330-7639 x772|