[interchange-cvs] interchange - heins modified 4 files
interchange-core@interchange.redhat.com
interchange-core@interchange.redhat.com
Tue Jun 11 16:31:01 2002
User: heins
Date: 2002-06-11 20:30:58 GMT
Modified: lib/Vend Config.pm UserDB.pm
Added: lib/Vend Accounting.pm
Added: lib/Vend/Accounting SQL_Ledger.pm
Log:
* Added new Vend::Accounting structure.
* Will be supported with account.coretag, probably just a map to
Vend::Accounting routine.
* Changed SQL_Ledger config var to Accounting, made selectable
as locale-style variable
* Added routines in UserDB to support assign_username and save_data
* Need to add capability structure to see if you should even try
to assign a new customer number or directly save data
* Object-oriented. In the process, I realized we need to update
Vend::Payment to be the same. I will do this.
Revision Changes Path
2.47 +4 -4 interchange/lib/Vend/Config.pm
rev 2.47, prev_rev 2.46
Index: Config.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/Config.pm,v
retrieving revision 2.46
retrieving revision 2.47
diff -u -r2.46 -r2.47
--- Config.pm 11 Jun 2002 04:33:54 -0000 2.46
+++ Config.pm 11 Jun 2002 20:30:58 -0000 2.47
@@ -1,6 +1,6 @@
# Vend::Config - Configure Interchange
#
-# $Id: Config.pm,v 2.46 2002/06/11 04:33:54 mheins Exp $
+# $Id: Config.pm,v 2.47 2002/06/11 20:30:58 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -44,7 +44,7 @@
use Vend::Parse;
use Vend::Util;
-$VERSION = substr(q$Revision: 2.46 $, 10);
+$VERSION = substr(q$Revision: 2.47 $, 10);
my %CDname;
@@ -128,7 +128,7 @@
SOAP 1
Mail 1
DatabaseDefault 1
- SQL_Ledger 1
+ Accounting 1
));
my %DumpSource = (qw(
@@ -485,7 +485,7 @@
['PriceDefault', undef, 'price'],
['PriceField', undef, 'price'],
['Shipping', 'locale', ''],
- ['SQL_Ledger', 'hash', ''],
+ ['Accounting', 'locale', ''],
['AutoVariable', 'autovar', ''],
];
2.4 +59 -13 interchange/lib/Vend/UserDB.pm
rev 2.4, prev_rev 2.3
Index: UserDB.pm
===================================================================
RCS file: /anon_cvs/repository/interchange/lib/Vend/UserDB.pm,v
retrieving revision 2.3
retrieving revision 2.4
diff -u -r2.3 -r2.4
--- UserDB.pm 4 Feb 2002 01:31:17 -0000 2.3
+++ UserDB.pm 11 Jun 2002 20:30:58 -0000 2.4
@@ -1,6 +1,6 @@
# Vend::UserDB - Interchange user database functions
#
-# $Id: UserDB.pm,v 2.3 2002/02/04 01:31:17 mheins Exp $
+# $Id: UserDB.pm,v 2.4 2002/06/11 20:30:58 mheins Exp $
#
# Copyright (C) 1996-2001 Red Hat, Inc. <interchange@redhat.com>
#
@@ -16,7 +16,7 @@
package Vend::UserDB;
-$VERSION = substr(q$Revision: 2.3 $, 10);
+$VERSION = substr(q$Revision: 2.4 $, 10);
use vars qw!
$VERSION
@@ -754,6 +754,31 @@
return undef;
}
+# Changes made to support Accounting Interface.
+
+ if(my $l = $Vend::Cfg->{Accounting}) {
+ my %hashvar;
+ my $indexvar = 0;
+ while ($indexvar <= (scalar @bfields)) {
+ $hashvar{ $bfields[$indexvar] } = $bvals[$indexvar];
+ $indexvar++;
+ };
+ my $obj;
+ my $class = $l->{Class};
+ eval {
+ $obj = $class->new;
+ };
+
+ if($@) {
+ die errmsg(
+ "Failed to save customer data with accounting system %s: %s",
+ $class,
+ $@,
+ );
+ }
+ my $returnval = $obj->save_customer_data($user, \%hashvar);
+ }
+
return 1;
}
@@ -1254,12 +1279,36 @@
}
sub assign_username {
- my $self = shift;
- my $file = shift || $self->{OPTIONS}{'counter'};
- my $start = $self->{OPTIONS}{username} || 'U00000';
- $file = './etc/username.counter' if ! $file;
- my $ctr = Vend::CounterFile->new($file, $start);
- return $ctr->inc();
+ my $self = shift;
+ my $file = shift || $self->{OPTIONS}{'counter'};
+ my $start = $self->{OPTIONS}{username} || 'U00000';
+ $file = './etc/username.counter' if ! $file;
+ my $ctr = Vend::CounterFile->new($file, $start);
+
+ my $custno = $ctr->inc();
+
+ if(my $l = $Vend::Cfg->{Accounting}) {
+
+ my $class = $l->{Class};
+
+#::logDebug("Accounting class is $class");
+ my $obj;
+ eval {
+ $obj = $class->new;;
+ };
+#::logDebug("Accounting object is $obj");
+
+ if($@) {
+ die errmsg(
+ "Failed to assign new customer number with accounting system %s",
+ $class,
+ );
+ }
+ $custno = $obj->assign_customer_number();
+#::logDebug("assigned new customer number $custno");
+ }
+
+ return $custno;
}
sub new_account {
@@ -1477,14 +1526,11 @@
#::logDebug("Called userdb function=$function opt=$opt " . Data::Dumper::Dumper($opt));
- if(ref $opt eq 'HASH') {
+ if(ref $opt) {
%options = %$opt;
}
- elsif (! ref $opt) {
- %options = ($opt, @_);
- }
else {
- %options = @_;
+ %options = ($opt, @_);
}
my $status = 1;
2.1 interchange/lib/Vend/Accounting.pm
rev 2.1, prev_rev 2.0
1.1 interchange/lib/Vend/Accounting/SQL_Ledger.pm
rev 1.1, prev_rev 1.0
Index: SQL_Ledger.pm
===================================================================
#
# Vend::Accounting::SQL_Ledger
#
# SQL-Ledger Accounting Interface for Interchange
#
# Copyright (c) 2002 Daniel H. Thompson
# All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License.
#
# However, I do request that this copyright notice remain attached
# to the file, and that you please attach a note listing any
# modifications you have made to the package.
#
# Copyright (c) 2002 Mike Heins
# Major changes made by Mike Heins to fit into Vend::Accounting interface
package Vend::Accounting::SQL_Ledger;
# See the bottom of this file for the POD documentation.
# Search for the string '=head'.
use strict;
use warnings;
use HTML::TokeParser;
use Vend::Util;
use Vend::Accounting;
use vars qw/$VERSION @ISA/;
@ISA = qw/ Vend::Accounting /;
# HARD-CODED GLOBALS.
# >>>>> Here are some globals that you might want to adjust <<<<<<
# The current SQL-Ledger install directory
our $SL_DIR = '/usr/local/sql-ledger/';
# The SQL-Ledger path to use for transactions
#our $SL_PATH = Vend::Util::escape_chars_url('bin/mozilla');
our $SL_PATH = 'bin/mozilla';
# The SQL-Ledger user-id to use for transactions
our $SL_USER = 'mike';
# The SQL-Ledger password to use for transactions
our $SL_PASS = 'flange';
# The SQL-Ledger service item name to use for transactions
our $SL_ITEM_NAME = 'test-service';
# The SQL-Ledger service item id to use for transactions
our $SL_ITEM_ID = '10073';
sub new {
my $class = shift;
my $opt = shift;
if(ref($opt) ne 'HASH') {
my $tmp = $opt;
$opt = { $tmp, @_ };
}
my $self = new Vend::Accounting;
$self->{Config} = {};
while (my ($k, $v) = each %{$Vend::Cfg->{Accounting}}) {
$self->{Config}{$k} = $v;
}
while (my ($k, $v) = each %$opt) {
$self->{Config}{$k} = $v;
}
bless $self, $class;
#::logDebug("Accounting self=" . ::uneval($self) );
return $self;
}
# ------------------ START OF THE LIBRARY ------------
sub push_parms {
my($k, $v, $ary) = @_;
if( ref($v) eq 'ARRAY') {
my $ary = $v;
for(@$ary) {
push @$ary, "$k=" . Vend::Util::escape_chars_url($_);
}
return;
}
$v = Vend::Util::escape_chars_url($v);
push @$ary, "$k=$v";
return;
}
sub split_name_value_pairs {
my $htmlstring = shift;
my $obj = HTML::TokeParser->new(doc => "$htmlstring");
my ($token, $urlstring, $pair, @pairs, $name, $value, $data, %data);
while ($token = $obj->get_tag("a")) {
$urlstring = $token->[1]{href};
#Split the name-value pairs
@pairs = split(/&/, $urlstring);
#Loop through each pair
foreach $pair (@pairs) {
#Create a Name/Value pair set
($name, $value) = split(/=/, $pair);
#Assign the value to an associative array using the name as its hash
$data{$name} = Vend::Util::unescape_full($value);
}
}
return %data;
}
sub call_sl_script {
my ($sname, $opt) = @_;
my $dir = $Vend::Cfg->{SQL_Ledger}{dir} || $SL_DIR;
$dir =~ s:/+$::;
my $cmd = "$dir/$sname";
local($ENV{PERL5LIB});
$ENV{PERL5LIB} = $dir;
# if($opt->{path} !~ m:^/:) {
# $opt->{path} = "$dir/$opt->{path}";
# }
if(! -f $cmd) {
logError(
"SQL-Ledger script '%s' does not exist in SL_DIR '%s'",
$sname,
$dir,
);
return undef;
}
# Build the option string. Keys beginning with sl_* override other
# passed parameters, meaning that even if the function parameter
# is needed in a standard opt string a 'function' parameter can
# be passed with sl_function=something.
my @parms;
my @override;
for my $k (keys %$opt) {
if($k =~ /^sl_/) {
push @override, $_;
next;
}
my $v = $opt->{$k};
push_parms($k, $v, \@parms);
}
for my $k (@override) {
my $v = $opt->{$k};
push_parms($k, $v, \@parms);
}
my $arg = join "&", @parms;
logDebug("calling $cmd with arg=$arg");
my $result = `$cmd "$arg"`;
chomp($result);
if($? != 0) {
my $err = $? >> 8;
logError(
"SQL-Ledger error status '%s' returned on call to '%s': %s",
$err,
$sname,
$!,
);
}
return $result;
}
sub hash_line_params {
my $body = shift
or return undef;
my $o;
if($body =~ /=/) {
$o = {};
$body =~ s/^\s+//;
$body =~ s/\s+$//;
$body =~ s/^\s+//mg;
$body =~ s/\s+$//mg;
my @in = grep /=/, split /\n/, $body;
for(@in) {
my ($k, $v) = split /\s*=\s*/, $_;
if($o->{$k}) {
my $val = delete $o->{$k};
if ( ref($val) eq 'ARRAY' ) {
push @$val, $v;
}
else {
$val = [ $val ];
}
$v = $val;
}
$o->{$k} = $v;
}
}
return $o;
}
sub assign_customer_number {
my ($self, $opt) = @_;
my $result;
my $call = {
path => $self->{Config}{path} || $SL_PATH,
login => $self->{Config}{login} || $SL_USER,
password => $self->{Config}{password} || $SL_PASS,
};
$call->{action} = "Save Customer";
$call->{db} = "customer";
$call->{name} = $opt->{username} || $::Values->{email};
$call->{contact} = $opt->{email} || $::Values->{email};
$call->{email} = $opt->{email} || $::Values->{email};
call_sl_script('ct.pl', $call);
$call->{action} = "Search for Customer";
$call->{l_contact} = "Y";
$call->{l_name} = "Y";
$result = call_sl_script('ct.pl', $call);
logDebug("call_sl_script result was: $result");
my %data = split_name_value_pairs($result);
my $datastuff = ::uneval(\@_);
logDebug("This is a assign_customer_number test(result '$data{id}') ... $datastuff");
return $data{id};
}
sub save_customer_data {
my ($self, $userid, $hashdata) = @_;
my $datastuff = uneval(\$self);
#::logDebug( "This is a save_customer_data self... $datastuff");
$datastuff = uneval($hashdata);
#::logDebug("This is a save_customer_data fnv... $datastuff");
$datastuff = uneval(\$userid);
#::logDebug("This is a save_customer_data userid .. $datastuff");
`echo "This is a save_customer_data userid... $datastuff" >> testlog.txt`;
my $result;
my %fnv = %$hashdata;
my $name;
my $call = {
path => $self->{Config}{path} || $SL_PATH,
login => $self->{Config}{login} || $SL_USER,
password => $self->{Config}{password} || $SL_PASS,
};
$call->{action} = "Save Customer";
$call->{db} = "customer";
$call->{id} = $userid;
$call->{name} = $fnv{company} || "$fnv{lname}, $fnv{fname}";
$call->{addr1} = $fnv{b_address1} || $fnv{address1};
$call->{addr2} = $fnv{b_address2} || $fnv{address2};
$call->{addr3} = $fnv{b_address3} || $fnv{address3};
if($fnv{b_city}) {
$call->{addr4} = "$fnv{b_city}, $fnv{b_state} $fnv{b_zip} $fnv{b_country}";
}
else {
$call->{addr4} = "$fnv{city}, $fnv{state} $fnv{zip} $fnv{country}";
}
if($fnv{b_lname}) {
$call->{contact} = "$fnv{b_lname}, $fnv{b_fname}";
}
else {
$call->{contact} = "$fnv{lname}, $fnv{fname}";
}
$call->{phone} = $fnv{phone_night} || $fnv{phone_day};
$call->{fax} = $fnv{fax};
$call->{email} = $fnv{email};
$call->{shiptoname} = $fnv{company} || "$fnv{lname}, $fnv{fname}";
$call->{shiptoaddr1} = $fnv{address1};
$call->{shiptoaddr2} = $fnv{address2};
$call->{shiptoaddr3} = $fnv{address3};
$call->{shiptoaddr4} = "$fnv{city} $fnv{state} $fnv{zip} $fnv{country}";
$call->{shiptocontact} = "$fnv{lname}, $fnv{fname}";
$call->{shiptophone} = $fnv{phone_day};
$call->{shiptofax} = $fnv{fax};
$call->{shiptoemail} = $fnv{email};
$call->{creditlimit} = $fnv{credit_limit};
$result = call_sl_script('ct.pl', $call);
return 1;
}
sub create_vendor_purchase_order {
my ($self, $string) = @_;
return $string;
}
sub create_order_entry {
my $self = shift;
my $order = shift;
unless(ref $order) {
my $ary = { $order, @_ };
$order = $ary;
}
my $result;
my $lineitem;
my $call = {
path => $self->{Config}{path} || $SL_PATH,
login => $self->{Config}{login} || $SL_USER,
password => $self->{Config}{password} || $SL_PASS,
};
$call->{action} = "Save Order";
$call->{type} = "sales_order";
$call->{new_form} = "1";
$call->{vc} = "customer";
$call->{title} = "Add Sales Order";
$call->{customer_id} = $order->{username};
$call->{discount} = "0";
$call->{customer} = $order->{compuser};
$call->{ordnumber} = $order->{orderno};
$call->{shippingpoint} = $order->{shipping};
$call->{currency} = "USD";
$call->{orddate} = $order->{date};
$call->{reqdate} = $order->{date};
$lineitem = 1;
for ( my $ln = 1; $ln <= $order->{lineitems}; $ln++ ) {
my $ref = $order->{orderitem}{$ln};
$call->{"qty_$ln"} = $ref->{quantity};
$call->{"unit_$ln"} = $ref->{uom} || 'each';
$call->{"partnumber_$ln"} = $ref->{part_number} || $SL_ITEM_NAME;
$call->{"description_$ln"} = $ref->{description};
$call->{"sellprice_$ln"} = $ref->{price};
$call->{"id_$ln"} = $ref->{part_id} || $SL_ITEM_ID;
$call->{"income_accno_$ln"} = $ref->{income_accno} || '4020';
$call->{"expense_accno_$ln"} = $ref->{expense_accno} || '5020';
$call->{"listprice_$ln"} = $ref->{price};
$call->{"assembly_$ln"} = 0;
}
$call->{notes} = $order->{notes} || "Notes";
$call->{rowcount} = $order->{lineitem};
$result = call_sl_script('oe.pl', $call);
return 1;
}
sub enter_payment {
my ($self, $string) = @_;
my $datastuff = ::uneval(\@_);
`echo "This is a enter_customer_payment test... $datastuff" >> testlog.txt`;
return $string;
}
return 1;
=head
SLInterface
SQL-Ledger Accounting Interface for Interchange
This module is an attempt to create a set of callable routines
that will allow the easy integration of the SQL-Ledger Accounting
package with "Red Hat's" Interchange.
It handles the mapping of the Interchange variable names to the
appropriate SQL-Ledger ones as well as parsing the html returned
by the SQL-Ledger "API".
Background: SQL-Ledger Accounting "www.sql-ledger.org"
is a multiuser, double entry, accounting system written in Perl
and is licensed under the GNU General Public License.
The SQL-Ledger API: SQL-Ledger functions can be accessed from the
command line by passing all the variables in one long string to
the perl script. The variable=value pairs must be separated by an
ampersand. See "www.sql-ledger.org/misc/api.html" for more details
on the command line interface.
------------------------------------------------------------------
This module also happens to be the author's first perl module and probably
his second or third perl program in addition to "Hello World". :)
So please go easy on me. -Daniel
=cut