From 3768b709beed40479f29657ecf77a6357697951f Mon Sep 17 00:00:00 2001 From: ivan Date: Fri, 15 Oct 2004 15:15:08 +0000 Subject: [PATCH] initial import --- Changes | 6 + MANIFEST | 8 + Makefile.PL | 18 ++ README | 34 ++++ cid.csv | 56 ++++++ cidhash.pl | 13 ++ lib/Net/Artera.pm | 509 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ t/Artera.t | 96 ++++++++++ 8 files changed, 740 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 cid.csv create mode 100755 cidhash.pl create mode 100644 lib/Net/Artera.pm create mode 100644 t/Artera.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..70c92be --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +Revision history for Perl extension Net::Artera. + +0.01 Thu Oct 14 22:43:25 2004 + - original version; created by h2xs 1.23 with options + -AX -n Net::Artera -b 5.5.0 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..6953585 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,8 @@ +Changes +Makefile.PL +MANIFEST +README +t/Artera.t +lib/Net/Artera.pm +cid.csv +cidhash.pl diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..c65494f --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +use 5.005; +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. +WriteMakefile( + NAME => 'Net::Artera', + VERSION_FROM => 'lib/Net/Artera.pm', # finds $VERSION + PREREQ_PM => { + 'LWP::UserAgent' => 0, + 'Crypt::SSLeay' => 0, + 'XML::Simple' => 0, + 'Data::Dumper' => 0, + 'Locale::Country' => 0, + }, # e.g., Module::Name => 1.1 + ($] >= 5.005 ? ## Add these new keywords supported since 5.005 + (ABSTRACT_FROM => 'lib/Net/Artera.pm', # retrieve abstract from module + AUTHOR => 'Ivan Kohler ') : ()), +); diff --git a/README b/README new file mode 100644 index 0000000..f27e954 --- /dev/null +++ b/README @@ -0,0 +1,34 @@ +Net-Artera version 0.01 +======================= + +This is a Perl module which speaks the Artera XML API. +See . Artera Resellers can use this module +to access some features of the API. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + + LWP (libwww-perl) + Crypt::SSLeay + XML::Simple + Data::Dumper + Locale::Country + +COPYRIGHT AND LICENCE + +Copyright (C) 2004 by Ivan Kohler + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + + diff --git a/cid.csv b/cid.csv new file mode 100644 index 0000000..195d7ff --- /dev/null +++ b/cid.csv @@ -0,0 +1,56 @@ +"CID","Country Name" +1,"UK" +2,"USA" +3,"INDIA" +4,"JAPAN" +5,"RUSSIA" +6,"FRANCE" +7,"POLAND" +8,"GREECE" +9,"UGANDA" +10,"SRI LANKA" +11,"SAUDI ARABIA" +12,"NETHERLANDS" +13,"PERU" +14,"CANADA" +15,"NEW ZEALAND" +16,"SOUTH KOREA" +17,"ITALY" +18,"SPAIN" +19,"ISRAEL" +20,"SWEDEN" +21,"GERMANY" +22,"IRELAND" +23,"MEXICO" +24,"AUSTRALIA" +25,"TONGA" +26,"EGYPT" +27,"TURKEY" +28,"ARMENIA" +29,"AZERBAIJAN" +30,"BELARUS" +31,"ESTONIA" +32,"GEORGIA" +33,"KAZAKHSTAN" +34,"KYRGYZSTAN" +35,"LITHUANIA" +36,"MOLDOVA" +38,"TAJIKISTAN" +39,"TURKMENISTAN" +40,"UKRAINE" +41,"UZBEKISTAN" +42,"BOSNIA" +43,"HERZEGOVINA" +44,"CROATIA" +45,"MACEDONIA" +46,"SERBIA" +47,"MONTENEGRO" +48,"SLOVENIA" +49,"ERITREA" +51,"MARSHALL ISLANDS" +52,"PALAU" +53,"Micronesia, Federated States of" +54,"NAMIBIA" +56,"LATVIA" +57,"SOUTH AFRICA" +58,"JAMAICA" diff --git a/cidhash.pl b/cidhash.pl new file mode 100755 index 0000000..70e5f0f --- /dev/null +++ b/cidhash.pl @@ -0,0 +1,13 @@ +#!/usr/bin/perl + +use Text::CSV_XS; +use Locale::Country; + +$csv = new Text::CSV_XS; + +while (<>) { + my $status = $csv->parse($_) or die "can't parse: ".$csv->error_input."\n"; + my($cid, $name) = $csv->fields(); + + print " '".country2code($name). "' => ", $cid. ",\n"; +} diff --git a/lib/Net/Artera.pm b/lib/Net/Artera.pm new file mode 100644 index 0000000..dfc6da1 --- /dev/null +++ b/lib/Net/Artera.pm @@ -0,0 +1,509 @@ +package Net::Artera; + +use 5.005; +use strict; +use Data::Dumper; +use URI::Escape; +use LWP::UserAgent; +use XML::Simple; +use Locale::Country; + +#require Exporter; +use vars qw($VERSION @ISA $DEBUG @login_opt); #$WARN ); + # @EXPORT @EXPORT_OK %EXPORT_TAGS); +#@ISA = qw(Exporter); + +# This allows declaration use Net-Artera ':all'; +# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK +# will save memory. +#%EXPORT_TAGS = ( 'all' => [ qw( +# +#) ] ); + +#@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); + +#@EXPORT = qw(); + +$VERSION = '0.01'; + +#$WARN = 0; +$DEBUG = 0; + +=head1 NAME + +Net::Artera - Perl extension for Artera XML API. + +=head1 SYNOPSIS + + use Net::Artera; + + my $connection = new Net::Artera ( + 'username' => 'reseller_username', + 'password' => 'reseller_password', + 'production' => 0, + ); + +=head1 DESCRIPTION + +This is a Perl module which speaks the Artera XML API. +See . Artera Resellers can use this module +to access some features of the API. + +=head1 METHODS + +=over 4 + +=item new [ OPTIONS_HASHREF | OPTION => VALUE ... ] + +Constructor. Options can be passed as a hash reference or a list. Options are +case-insensitive. + +Available options are: + +=over 4 + +=item username - Reseller username + +=item password - Reseller password + +=item rid - Reseller ID (RID) + +=item pid - Product ID (PID). + +=item production - if set true, uses the production server instead of the staging server. + +=back + +=cut + +@login_opt = qw( RID Username Password ); + +sub new { + my $proto = shift; + my $class = ref($proto) || $proto; + my $self = {}; + bless ($self, $class); + + my $opt = $self->_lc_hash_or_hashref(@_); + $self->{$_} = $opt->{$_} for map lc($_), @login_opt; + + if ( defined($opt->{'production'}) && $opt->{'production'} ) { + $self->{'url'} = 'https://secure.arteragroup.com/'; + } else { + $self->{'url'} = 'http://staging.arteragroup.com/'; + } + $self->{'url'} .= 'Wizards/wsapi/31/APIService.asmx'; + + $self->{'ua'} = LWP::UserAgent->new; + + warn "\n$self created: ". Dumper($self) if $DEBUG; + + $self; +} + +sub _lc_hash_or_hashref { + my $self = shift; + my $opt = ref($_[0]) ? shift : {@_}; + my $gratuitous = { map { lc($_) => $opt->{$_} } keys %$opt }; + $gratuitous; +} + +=item newTrial [ OPTIONS_HASHREF | OPTION => VALUE ... ] + +Options can be passed as a hash reference or a list. Options are +case-insensitive. + +Available options are: + +=over 4 + +=item email (required) + +=item cname (required) - Customer's name + +=item ref (required) - Reseller's own order reference + +=item pid (required) - Artera Product ID + +=item priceid (required) - Artera Price ID + +=item aid - Affiliate ID number used when the Reseller wants to track some type of sales channel beneath them. + +=item add1* + +=item add2 + +=item add3* - City + +=item add4* - State + +=item zip* + +=item cid* - Country ID. Defaults to 2 (USA). Can be specified as a numeric CID or as an ISO 3166 two-letter country code or full name. + +=item phone + +=item fax + +=back + +*These fields are optional, but must be supplied as a set. + +Returns a hash reference with the following keys (these keys B +case-sensitive): + +=over 4 + +=item id - This is the Result ID to indicate success or failure: 1 for success, anything else for failure + +=item message - Some descriptive text regarding the success or failure + +=item ASN - The Artera Serial Number + +=item AKC - The Artera Key Code + +=item TrialID - The Artera Trial Number + +=item Ref - The Reseller Reference + +=item CustomerID - Artera's CustomerID + +=item TrialLength - Trial Length + +=cut + +sub newTrial { + my $self = shift; + my $opt = $self->_lc_hash_or_hashref(@_); + $self->_newX('Trial', $opt); +} + +=item newOrder [ OPTIONS_HASHREF | OPTION => VALUE ... ] + +Available options are the same as B. Additionally the I and +I fields may be specified to convert a trial to an order. + +=cut + +sub newOrder { + my $self = shift; + my $opt = $self->_lc_hash_or_hashref(@_); + push @{$opt->{'optional_params'}}, qw( ASN AKC ); + $self->_newX('Order', $opt); +} + +sub _newX { + my( $self, $x, $opt ) = @_; + + if ( defined($opt->{'cid'}) ) { + $opt->{'cid'} = $self->_country2cid($opt->{'cid'}); + } else { + $opt->{'cid'} = 2 if grep defined($_), qw(Add1 Add3 Add4 Zip); + } + + push @{$opt->{'required_params'}}, + qw( Email CName Ref PID PriceID ); + push @{$opt->{'optional_params'}}, + qw( AID Add1 Add2 Add3 Add4 Zip CID Phone Fax ); + + $self->_submit( "new$x", $opt ); + +} + +my %country2cid = ( + 'uk' => 1, + 'gb' => 1, + 'us' => 2, + 'in' => 3, + 'jp' => 4, + 'ru' => 5, + 'fr' => 6, + 'pl' => 7, + 'gr' => 8, + 'ug' => 9, + 'lk' => 10, + 'sa' => 11, + 'nl' => 12, + 'pe' => 13, + 'ca' => 14, + 'nz' => 15, + 'kr' => 16, + 'it' => 17, + 'es' => 18, + 'il' => 19, + 'se' => 20, + 'de' => 21, + 'ie' => 22, + 'mx' => 23, + 'au' => 24, + 'to' => 25, + 'eg' => 26, + 'tr' => 27, + 'am' => 28, + 'az' => 29, + 'by' => 30, + 'ee' => 31, + 'ge' => 32, + 'kz' => 33, + 'kg' => 34, + 'lt' => 35, + 'md' => 36, + 'tj' => 38, + 'tm' => 39, + 'ua' => 40, + 'uz' => 41, + '' => 42, #BOSNIA + '' => 43, #HERZEGOVINA + 'hr' => 44, + 'mk' => 45, + '' => 46, #SERBIA + '' => 47, #MONTENEGRO + 'si' => 48, + 'er' => 49, + 'mh' => 51, + 'pw' => 52, + 'fm' => 53, + 'na' => 54, + 'lv' => 56, + 'za' => 57, + 'jm' => 58, +); + +sub _country2cid { + my( $self, $country ) = @_; + if ( $country =~ /^\s*(\d+)\s*$/ ) { + $1; + } elsif ( $country =~ /^\s*(\w\w)\s*$/ ) { + $country2cid{$1}; + } elsif ( $country !~ /^\s*$/ ) { + $country2cid{country2code($country)}; + } else { + ''; + } +} + +=item statusChange [ OPTIONS_HASHREF | OPTION => VALUE ... ] + +Options can be passed as a hash reference or a list. Options are +case-insensitive. + +Available options are: + +=over 4 + +=item ASN (required) - Artera Serial Number + +=item AKC (required) - Artera Key Code + +=item StatusID (required) - Possible StatusID values are as follows: + +=over 4 + +=item 15 - Normal Unrestricted: re-enable a disabled Serial Number (e.g. a payment dispute has been resolved so the Serial Number needs to be re-enabled). + +=item 16 - Disable: temporarily prohibit an end-user's serial number from working (e.g. there is a payment dispute, so you want to turn off the Serial Number until the dispute is resolved). + +=item 17 - Terminate: permanently prohibit an end-user's Serial Number from working (e.g. subscription cancellation) + +=back + +=item Reason - Reason for terminating + +=back + +Returns a hash reference with the following keys (these keys B +case-sensitive): + +=over 4 + +=item id - This is the Result ID to indicate success or failure: 1 for success, anything else for failure + +=item message - Some descriptive text regarding the success or failure + +=back + +=cut + +sub statusChange { + my $self = shift; + my $opt = $self->_lc_hash_or_hashref(@_); + + push @{$opt->{'required_params'}}, + qw( ASN AKC StatusID ); + push @{$opt->{'optional_params'}}, 'Reason'; + + $self->_submit('statusChange', $opt ); +} + +=item getProductStatus [ OPTIONS_HASHREF | OPTION => VALUE ... ] + +Options can be passed as a hash reference or a list. Options are +case-insensitive. + +Available options are: + +=over 4 + +=item ASN (required) - Artera Serial Number + +=item AKC (required) - Artera Key Code + +=back + +Returns a hash reference with the following keys (these keys B +case-sensitive): + +=over 4 + +=item id - This is the Result ID to indicate success or failure: 1 for success, anything else for failure + +=item message - On failure, descriptive text regarding the failure + +=item StatusID (required) - Possible StatusID values are as follows: + +=over 4 + +=item 15 - Normal Unrestricted: re-enable a disabled Serial Number (e.g. a payment dispute has been resolved so the Serial Number needs to be re-enabled). + +=item 16 - Disable: temporarily prohibit an end-user's serial number from working (e.g. there is a payment dispute, so you want to turn off the Serial Number until the dispute is resolved). + +=item 17 - Terminate: permanently prohibit an end-user's Serial Number from working (e.g. subscription cancellation) + +=back + +=item Description - Status description + +=back + +=cut + +sub getProductStatus { + my $self = shift; + + my $opt = $self->_lc_hash_or_hashref(@_); + + push @{$opt->{'required_params'}}, qw( ASN AKC ); + + my $result = $self->_submit('getProductStatus', $opt ); + + # munch results, present as flat list + $result->{$_} = $result->{'Status'}->{$_} foreach (qw(StatusID Description)); + delete $result->{'Status'}; + + $result; + +} + +=item updateContentControl [ OPTIONS_HASHREF | OPTION => VALUE ... ] + +Options can be passed as a hash reference or a list. Options are +case-insensitive. + +Available options are: + +=over 4 + +=item ASN (required) - Artera Serial Number + +=item AKC (required) - Artera Key Code + +=item UseContentControl (required) - 0 for off, 1 for on + +=back + +Returns a hash reference with the following keys (these keys B +case-sensitive): + +=over 4 + +=item id - This is the Result ID to indicate success or failure: 1 for success, anything else for failure + +=item message - Some descriptive text regarding the success or failure + +=back + +=cut + +sub updateContentControl { + my $self = shift; + + my $opt = $self->_lc_hash_or_hashref(@_); + + push @{$opt->{'required_params'}}, qw( ASN AKC UseContentControl ); + + $self->_submit('updateContentControl', $opt ); +} + +=item orderListByDate [ OPTIONS_HASHREF | OPTION => VALUE ... ] + +Unimplemented. + +=cut + +#-- + +sub _submit { + my( $self, $method, $opt ) = @_; + my $ua = $self->{'ua'}; + + my $param = { + ( map { $_ => $self->{lc($_)} } + @login_opt, + ), + ( map { $_ => $opt->{lc($_)} } + @{$opt->{'required_params'}} + ), + ( map { $_ => ( exists $opt->{lc($_)} ? $opt->{lc($_)} : '' ) } + @{$opt->{'optional_params'}} + ), + }; + warn "$self url $self->{url}/$method\n" if $DEBUG; + warn "$self request parameters: ". Dumper($param). "\n" if $DEBUG; + + #POST + my $response = $ua->post( "$self->{'url'}/$method", $param ); + + warn "$self raw response: ". $response->content. "\n" if $DEBUG; + + #unless ( $response->is_success ) { + # die $response->content; + #} + + my $xml = XMLin( $response->content ); + warn "$self parsed response: ". Dumper($xml) if $DEBUG; + + #warn "\n".$xml->{'message'}."\n" unless $xml->{'id'} == 1 or not $WARN; + + $xml; + +} + +=back + +=head1 BUGS + +orderListByDate is unimplemented. + +=head1 SEE ALSO + + + +=head1 AUTHOR + +Ivan Kohler, Eivan-net-artera@420.amE + +Freeside, open-source billing for ISPs: + +Not affiliated with Artera Group, Inc. + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2004 Ivan Kohler + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut + +1; + diff --git a/t/Artera.t b/t/Artera.t new file mode 100644 index 0000000..65ddefd --- /dev/null +++ b/t/Artera.t @@ -0,0 +1,96 @@ +# Before `make install' is performed this script should be runnable with +# `make test'. After `make install' it should work as `perl Artera.t' + +######################### + +# change 'tests => 1' to 'tests => last_test_to_print'; +use Test; +BEGIN { plan tests => 8 }; +use Net::Artera; +ok(1); # If we made it this far, we're ok. + +######################### + +#$Net::Artera::WARN = 1; +#$Net::Artera::DEBUG = 1; + +# Insert your test code below, the Test::More module is use()ed here so read +# its man page ( perldoc Test::More ) for help writing this test script. + +# 2 +my $conn = new Net::Artera ( 'username' => 'CRMAPITEST@API.COM', + 'password' => 'CRMAPI', + 'rid' => 137044, + 'production' => 0, + ); + +ok(ref($conn), 'Net::Artera', 'create new Net::Artera object' ); + +my $base_param = { + 'email' => 'ivan-net-artera-test-'. time. '@example.com', + 'cname' => 'Tofu Beast', + 'ref' => 420, + #'aid' => 23, + 'add1' => '54 Street Rd.', + 'add3' => 'Tofu Towers', + 'add4' => 'CA', + 'zip' => '54321', + #'cid' => 'US', +}; + +# 3 +my $param = { %$base_param, 'pid' => 68, 'priceid' => 52, }; +my $r_newTrial = $conn->newTrial( $param ); +ok( $r_newTrial->{'id'} == 1 || $r_newTrial->{'message'}, 1, + 'newTrial method' ); + +# 4 +$param = { %$base_param, 'pid' => 69, 'priceid' => 53, }; +$param->{$_} = $r_newTrial->{$_} foreach (qw(ASN AKC)); +my $r_newOrder_convert = $conn->newOrder( $param ); +ok( $r_newOrder_convert->{'id'} == 1 || $r_newOrder_convert->{'message'}, 1, + 'newOrder convert method' ); + +# 5 +$param = { %$base_param, 'pid' => 69, 'priceid' => 53, }; +my $r_newOrder = $conn->newOrder( $param ); +ok( $r_newOrder->{'id'} == 1 || $r_newOrder->{'message'}, 1, + 'newOrder method' ); + +# 6 +my $r_statusChange = + $conn->statusChange( 'StatusID' => 16, + map { $_ => $r_newOrder->{$_} } qw(ASN AKC) + ); +ok( $r_statusChange->{'id'} == 1 || $r_statusChange->{'message'}, 1, + 'statusChange method' ); + +# 7 +my $r_getProductStatus = + $conn->getProductStatus( map { $_ => $r_newOrder->{$_} } qw(ASN AKC) ); +ok( $r_getProductStatus->{'StatusID'} == 16, 1, 'getProductStatus method' ); + +# 8 +my $r_updateContentControl = + $conn->updateContentControl( 'UseContentControl' => 1, + map { $_ => $r_newOrder->{$_} } qw(ASN AKC) ); +ok( $r_getProductStatus->{'id'} == 1, 1, 'getProductStatus method' ); + + +#$param->{'pid'} = 68; +#for my $priceid ( 1 .. 100 ) { +# $param->{'priceid'} = $priceid; +# my $r = $conn->newTrial( $param ); +# ok( $r->{'id'} != 1, 1 , "newTrial priceid test $priceid" ); +#} +# +#$param->{'pid'} = 69; +#for my $priceid ( 1 .. 100 ) { +# $param->{'priceid'} = $priceid; +# my $r = $conn->newOrder( $param ); +# ok( $r->{'id'} != 1, 1 , "newOrder priceid test $priceid" ); +#} + + + + -- 2.11.0