Initial import of Net::IkanoSTART

11 files changed, 627 insertions, 0 deletions

diff --git a/.cvsignore b/.cvsignore
new file mode 100644
index 0000000..1039091
--- /dev/null
+++ b/.cvsignore
@@ -0,0 +1,10 @@
+blib*
+Makefile
+Makefile.old
+Build
+_build*
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+Net-Vitelity-*
+cover_db
diff --git a/Changes b/Changes
new file mode 100644
index 0000000..908c458
--- /dev/null
+++ b/Changes
@@ -0,0 +1,5 @@
+Revision history for Net-Ikano
+
+0.01    unreleased
+        First version
+
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..4be5e40
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,9 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+lib/Net/Ikano.pm
+lib/Net/Ikano/XMLUtil.pm
+t/00-load.t
+t/pod-coverage.t
+t/pod.t
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..358637f
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,16 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME                => 'Net::Ikano',
+    AUTHOR              => 'Erik Levinson <levinse@freeside.biz>',
+    VERSION_FROM        => 'lib/Net/Ikano.pm',
+    ABSTRACT_FROM       => 'lib/Net/Ikano.pm',
+    PL_FILES            => {},
+    PREREQ_PM => {
+        'Test::More' => 0,
+    },
+    dist                => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+    clean               => { FILES => 'Net-Ikano-*' },
+);
diff --git a/README b/README
new file mode 100644
index 0000000..88d69ed
--- /dev/null
+++ b/README
@@ -0,0 +1,43 @@
+Net-Ikano
+
+This is an interface to the Ikano wholesale DSL API. 
+It is useful only if you have an account with Ikano.
+
+INSTALLATION
+
+To install this module, run the following commands:
+
+	perl Makefile.PL
+	make
+	make test
+	make install
+
+SUPPORT AND DOCUMENTATION
+
+After installing, you can find documentation for this module with the
+perldoc command.
+
+    perldoc Net::Ikano
+
+You can also look for information at:
+
+    RT, CPAN's request tracker
+        http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Ikano
+
+    AnnoCPAN, Annotated CPAN documentation
+        http://annocpan.org/dist/Net-Ikano
+
+    CPAN Ratings
+        http://cpanratings.perl.org/d/Net-Ikano
+
+    Search CPAN
+        http://search.cpan.org/dist/Net-Ikano
+
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2009 Freeside Internet Services, Inc.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
diff --git a/lib/Net/Ikano.pm b/lib/Net/Ikano.pm
new file mode 100644
index 0000000..acbc6c2
--- /dev/null
+++ b/lib/Net/Ikano.pm
@@ -0,0 +1,405 @@
+package Net::Ikano;
+
+use warnings;
+use strict;
+use Net::Ikano::XMLUtil;
+use LWP::UserAgent;
+use Data::Dumper;
+
+=head1 NAME
+
+Net::Ikano - Interface to Ikano wholesale DSL API
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+our $URL = 'https://orders.value.net/OsirisWebService/XmlApi.aspx';
+
+our $SCHEMA_ROOT = 'https://orders.value.net/osiriswebservice/schema/v1';
+
+our $API_VERSION = "1.0";
+
+our $AUTOLOAD;
+
+=head1 SYNOPSIS
+
+    use Net::Ikano;
+
+    my $ikano = Net::Ikano->new(
+	       'keyid' => $your_ikano_api_keyid,
+	       'password'  => $your_ikano_admin_user_password,
+	       'debug' => 1 # remove this for prod
+	       'reqpreviewonly' => 1 # remove this for prod
+	       'minimalQualResp' => 1 # on quals, return pairs of ProductCustomId+TermsId only
+	       'minimalOrderResp' => 1 # return minimal data on order responses
+			     );
+    
+=head1 SUPPORTED API METHODS
+
+=item ORDER
+
+NOTE: supports orders by ProductCustomId only
+
+$ikano->ORDER(
+    {
+	orderType => 'NEW',
+	ProductCustomId => 'abc123',
+	TermsId => '123',
+	DSLPhoneNumber => '4167800000',
+	Password => 'abc123',
+	PrequalId => '12345',
+	CompanyName => 'abc co',
+	FirstName => 'first',
+	LastName => 'last',
+	MiddleName => '',
+	ContactMethod => 'PHONE',
+	ContactPhoneNumber => '4167800000',
+	ContactEmail => 'x@x.ca',
+	ContactFax => '',
+	DateToOrder => '2010-11-29',
+	RequestClientIP => '127.0.0.1',
+	IspChange => 'NO',
+	IspPrevious => '',
+	CurrentProvider => '',
+    }
+);
+
+
+=item CANCEL
+
+$i->CANCEL(
+    { OrderId => 555 }
+);
+
+
+=item PREQUAL
+
+$ikano->PREQUAL( {
+    AddressLine1 => '123 Test Rd',
+    AddressUnitType => '', 
+    AddressUnitValue =>  '',
+    AddressCity =>  'Toronto',
+    AddressState => 'ON',
+    ZipCode => 'M6C 2J9', # or 12345
+    Country => 'CA', # or US
+    LocationType => 'R', # or B
+    PhoneNumber => '4167800000',
+    RequestClientIP => '127.0.0.1',
+    CheckNetworks => 'ATT,BELLCA,VER', # either one or command-separated like this
+} );
+
+
+=item ORDERSTATUS
+
+$ikano->ORDERSTATUS( 
+    { OrderId => 1234 }
+);
+
+
+=item PASSWORDCHANGE 
+
+$ikano->PASSWORDCHANGE( {
+	    DSLPhoneNumber => '4167800000',
+	    NewPassword => 'xxx',
+	} );
+
+
+=item CUSTOMERLOOKUP
+
+$ikano->CUSTOMERLOOKUP( { PhoneNumber => '4167800000' } );
+
+
+=item ACCOUNTSTATUSCHANGE
+
+$ikano->ACCOUNTSTATUSCHANGE(( {
+	    type => 'SUSPEND',
+	    DSLPhoneNumber => '4167800000',
+	    DSLServiecId => 123,
+	} );
+
+=cut
+
+sub new {
+    my ($class,%data) = @_;
+    die "missing keyid and/or password" 
+	unless defined $data{'keyid'} && defined $data{'password'};
+    my $self = { 
+	'keyid' => $data{'keyid'},
+	'password' => $data{'password'},
+	'username' => $data{'username'} ? $data{'username'} : 'admin',
+	'debug' => $data{'debug'} ? $data{'debug'} : 0,
+	'reqpreviewonly' => $data{'reqpreviewonly'} ? $data{'reqpreviewonly'} : 0,
+	};
+    bless $self, $class;
+    return $self;
+}
+
+
+sub req_ORDER {
+   my ($self, $args) = (shift, shift);
+
+   my @validOrderTypes = qw( NEW CHANGE CANCEL );
+
+    die "invalid order data" unless defined $args->{orderType}
+	&& defined $args->{ProductCustomId} && defined $args->{DSLPhoneNumber};
+   die "invalid order type ".$args->{orderType}
+    unless grep($_ eq $args->{orderType}, @validOrderTypes);
+
+    # XXX: rewrite this uglyness?
+    my @ignoreFields = qw( orderType ProductCustomId );
+    my %orderArgs = ();
+    while ( my ($k,$v) = each(%$args) ) {
+	$orderArgs{$k} = [ $v ] unless grep($_ eq $k,@ignoreFields);
+    }
+
+    return Order => {
+	type => $args->{orderType},
+	%orderArgs,
+	ProductCustomId => [ split(',',$args->{ProductCustomId}) ],
+    };
+}
+
+sub resp_ORDER {
+   my ($self, $resphash, $reqhash) = (shift, shift);
+   die "invalid order response" unless defined $resphash->{OrderResponse};
+   return $resphash->{OrderResponse};
+}
+
+sub req_CANCEL {
+   my ($self, $args) = (shift, shift);
+
+    die "no order id for cancel" unless defined $args->{OrderId};
+
+    return Cancel => {
+	OrderId => [ $args->{OrderId} ],
+    };
+}
+
+sub resp_CANCEL {
+   my ($self, $resphash, $reqhash) = (shift, shift);
+   die "invalid cancel response" unless defined $resphash->{OrderResponse};
+   return $resphash->{OrderResponse};
+}
+
+sub req_ORDERSTATUS {
+   my ($self, $args) = (shift, shift);
+
+   die "ORDERSTATUS is supported by OrderId only" 
+    if defined $args->{PhoneNumber} || !defined $args->{OrderId};
+
+    return OrderStatus => {
+	OrderId => [ $args->{OrderId} ],
+    };
+}
+
+sub resp_ORDERSTATUS {
+   my ($self, $resphash, $reqhash) = (shift, shift);
+   die "invalid order response" unless defined $resphash->{OrderResponse};
+   return $resphash->{OrderResponse};
+}
+
+sub req_ACCOUNTSTATUSCHANGE {
+   my ($self, $args) = (shift, shift);
+   die "invalid account status change request" unless defined $args->{type} 
+    && defined $args->{DSLServiceId} && defined $args->{DSLPhoneNumber};
+
+   return AccountStatusChange => {
+       type => $args->{type},
+	DSLPhoneNumber => [ $args->{DSLPhoneNumber} ],
+	DSLServiceId => [ $args->{DSLServiceId} ],
+    };
+}
+
+sub resp_ACCOUNTSTATUSCHANGE {
+   my ($self, $resphash, $reqhash) = (shift, shift);
+    die "invalid account status change response" 
+	unless defined $resphash->{AccountStatusChangeResponse}
+	&& defined $resphash->{AccountStatusChangeResponse}->{Customer};
+    return $resphash->{AccountStatusChangeResponse}->{Customer};
+}
+
+sub req_CUSTOMERLOOKUP {
+   my ($self, $args) = (shift, shift);
+   die "invalid customer lookup request" unless defined $args->{PhoneNumber};
+   return CustomerLookup => {
+	PhoneNumber => [ $args->{PhoneNumber} ],
+   };
+}
+
+sub resp_CUSTOMERLOOKUP {
+   my ($self, $resphash, $reqhash) = (shift, shift);
+   die "invalid customer lookup response" 
+    unless defined $resphash->{CustomerLookupResponse}
+	&& defined $resphash->{CustomerLookupResponse}->{Customer};
+   return $resphash->{CustomerLookupResponse}->{Customer};
+}
+
+sub req_PASSWORDCHANGE {
+   my ($self, $args) = (shift, shift);
+   die "invalid arguments to PASSWORDCHANGE" 
+	unless defined $args->{DSLPhoneNumber} && defined $args->{NewPassword};
+
+   return PasswordChange => {
+	DSLPhoneNumber => [ $args->{DSLPhoneNumber} ],
+	NewPassword => [ $args->{NewPassword} ],
+   };
+}
+
+sub resp_PASSWORDCHANGE {
+   my ($self, $resphash, $reqhash) = (shift, shift);
+   die "invalid change password response" unless defined $resphash->{ChangePasswordResponse};
+   return $resphash->{ChangePasswordResponse};
+}
+
+sub req_PREQUAL {
+   my ($self, $args) = (shift, shift);
+   return PreQual => { 
+        Address =>  [ { ( 
+	    map { $_ => [ $args->{$_} ]  }  
+		qw( AddressLine1 AddressUnitType AddressUnitValue AddressCity 
+		    AddressState ZipCode LocationType Country ) 
+	    )  } ],
+	( map { $_ => [ $args->{$_} ] } qw( PhoneNumber RequestClientIP ) ),
+	CheckNetworks => [ {
+	    Network => [ split(',',$args->{CheckNetworks}) ]
+	} ],
+       };
+}
+
+sub resp_PREQUAL {
+    my ($self, $resphash, $reqhash) = (shift, shift);
+    die "invalid prequal response" unless defined $resphash->{PreQualResponse};
+    return $resphash->{PreQualResponse};
+}
+
+sub AUTOLOAD {
+    my $self = shift;
+   
+    $AUTOLOAD =~ /(^|::)(\w+)$/ or die "invalid AUTOLOAD: $AUTOLOAD";
+    my $cmd = $2;
+    return if $cmd eq 'DESTROY';
+
+    my $reqsub = "req_$cmd";
+    my $respsub = "resp_$cmd";
+    die "invalid request type $cmd" 
+	unless defined &$reqsub && defined &$respsub;
+
+    my $reqargs = shift;
+
+    my $xs = new Net::Ikano::XMLUtil(RootName => undef, SuppressEmpty => 1 );
+    my $reqhash = {
+	    OsirisRequest   => {
+		type	=> $cmd,
+		keyid	=> $self->{keyid},
+		username => $self->{username},
+		password => $self->{password},
+		version => $API_VERSION,
+		xmlns   => "$SCHEMA_ROOT/osirisrequest.xsd",
+		$self->$reqsub($reqargs),
+	    }
+	};
+
+
+    my $reqxml = "<?xml version=\"1.0\"?>\n".$xs->XMLout($reqhash, NoSort => 1);
+   
+    # XXX: validate against their schema to ensure we're not sending invalid XML?
+
+    print "DEBUG REQUEST\n\tHASH:\n ".Dumper($reqhash)."\n\tXML:\n $reqxml \n\n" if $self->{debug};
+    
+    my $ua = LWP::UserAgent->new;
+
+    die "posting disabled for testing" if $self->{reqpreviewonly};
+
+    my $resp = $ua->post($URL, Content_Type => 'text/xml', Content => $reqxml);
+    die $resp->status_line unless $resp->is_success;
+    my $respxml = $resp->decoded_content;
+    my $resphash = $xs->XMLin($respxml);
+
+    print "DEBUG RESPONSE\n\tHASH:\n ".Dumper($resphash)."\n\tXML:\n $respxml" if $self->{debug};
+
+    # XXX: validate against their schema to ensure they didn't send us invalid XML?
+
+    die "invalid response" unless defined $resphash->{responseid} 
+	&& defined $resphash->{version} && defined $resphash->{type};
+
+    die "FAILURE response received: ".$resphash->{FailureResponse}->{FailureMessage}
+	if $resphash->{type} eq 'FAILURE';
+
+    my $validRespTypes = {
+	'PREQUAL' => qw( PREQUAL ),
+	'ORDERSTATUS' => qw( ORDERSTATUS ),
+	'ORDER' => qw( NEWORDER CHANGEORDER CANCELORDER ),
+	'CANCEL' => qw( ORDERCANCEL ),
+	'PASSWORDCHANGE' => qw( PASSWORDCHANGE ),
+	'ACCOUNTSTATUSCHANGE' => qw( ACCOUNTSTATUSCHANGE ),
+	'CUSTOMERLOOKUP' => qw( CUSTOMERLOOKUP ),
+    };
+
+    die "invalid response type for request type"
+	unless grep( $_ eq $resphash->{type}, $validRespTypes->{$cmd});
+
+    return $self->$respsub($resphash,$reqhash);
+}
+
+
+=head1 AUTHOR
+
+Erik Levinson, C<< <levinse at freeside.biz> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to C<bug-net-ikano at rt.cpan.org>, or through
+the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Ikano>.  I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+    perldoc Net::Ikano
+
+You can also look for information at:
+
+=over 4
+
+=item * RT: CPAN's request tracker
+
+L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Ikano>
+
+=item * AnnoCPAN: Annotated CPAN documentation
+
+L<http://annocpan.org/dist/Net-Ikano>
+
+=item * CPAN Ratings
+
+L<http://cpanratings.perl.org/d/Net-Ikano>
+
+=item * Search CPAN
+
+L<http://search.cpan.org/dist/Net-Ikano>
+
+=back
+
+=head1 ACKNOWLEDGEMENTS
+
+This module was developed by Freeside Internet Services, Inc.
+If you need a complete, open-source web-based application to manage your
+customers, billing and trouble ticketing, please visit http://freeside.biz/
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2010 Freeside Internet Services, Inc.
+All rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
+
diff --git a/lib/Net/Ikano/XMLUtil.pm b/lib/Net/Ikano/XMLUtil.pm
new file mode 100644
index 0000000..0439a57
--- /dev/null
+++ b/lib/Net/Ikano/XMLUtil.pm
@@ -0,0 +1,45 @@
+package Net::Ikano::XMLUtil;
+
+use warnings;
+use strict;
+use base 'XML::Simple';
+use Data::Dumper;
+use Switch;
+
+=head1 DESCRIPTION
+    
+Unfortunately the Ikano API schema has xs:sequence everywhere, so we need to have most elements in a particular order.
+This class solves this problem by extending XML::Simple and overriding sorted_keys to provide the element order for each request.
+
+IMPORTANT: when using this class, XMLOut must have SuppressEmpty => 1 as an option.
+You will break everything otherwise.
+
+=cut
+
+sub sorted_keys {
+    my ($self,$name,$hashref) = @_;
+
+    switch ($name) { 
+
+	# quals
+	return qw( AddressLine1 AddressUnitType AddressUnitValue AddressCity
+		    AddressState ZipCode Country LocationType ) case 'Address';
+	return qw( Address PhoneNumber CheckNetworks RequestClientIP ) case 'PreQual';
+
+	# orders
+	return qw( type ProductCustomId DSLPhoneNumber VirtualPhoneNumber Password
+	    TermsId PrequalId CompanyName FirstName MiddleName LastName
+	    ContactMethod ContactPhoneNumber ContactEmail ContactFax DateToOrder
+	    RequestClientIP IspChange IspPrevious CurrentProvider ) case 'Order';
+
+	# password change
+	return qw( DSLPhoneNumber NewPassword ) case 'PasswordChange';
+
+	# account status change
+	return qw( type DSLServiceId DSLPhoneNumber ) case 'AccountStatusChange';
+
+    }
+    return $self->SUPER::sorted_keys($name, $hashref);
+}
+
+1;
diff --git a/t/00-load.t b/t/00-load.t
new file mode 100644
index 0000000..eedbcde
--- /dev/null
+++ b/t/00-load.t
@@ -0,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+	use_ok( 'Net::Ikano' );
+}
+
+diag( "Testing Net::Ikano $Net::Ikano::VERSION, Perl $], $^X" );
diff --git a/t/boilerplate.t b/t/boilerplate.t
new file mode 100644
index 0000000..6a6ec78
--- /dev/null
+++ b/t/boilerplate.t
@@ -0,0 +1,55 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+sub not_in_file_ok {
+    my ($filename, %regex) = @_;
+    open( my $fh, '<', $filename )
+        or die "couldn't open $filename for reading: $!";
+
+    my %violated;
+
+    while (my $line = <$fh>) {
+        while (my ($desc, $regex) = each %regex) {
+            if ($line =~ $regex) {
+                push @{$violated{$desc}||=[]}, $.;
+            }
+        }
+    }
+
+    if (%violated) {
+        fail("$filename contains boilerplate text");
+        diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+    } else {
+        pass("$filename contains no boilerplate text");
+    }
+}
+
+sub module_boilerplate_ok {
+    my ($module) = @_;
+    not_in_file_ok($module =>
+        'the great new $MODULENAME'   => qr/ - The great new /,
+        'boilerplate description'     => qr/Quick summary of what the module/,
+        'stub function definition'    => qr/function[12]/,
+    );
+}
+
+TODO: {
+  local $TODO = "Need to replace the boilerplate text";
+
+  not_in_file_ok(README =>
+    "The README is used..."       => qr/The README is used/,
+    "'version information here'"  => qr/to provide version information/,
+  );
+
+  not_in_file_ok(Changes =>
+    "placeholder date/time"       => qr(Date/time)
+  );
+
+  module_boilerplate_ok('lib/Net/Ikano.pm');
+
+
+}
+
diff --git a/t/pod-coverage.t b/t/pod-coverage.t
new file mode 100644
index 0000000..fc40a57
--- /dev/null
+++ b/t/pod-coverage.t
@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod::Coverage
+my $min_tpc = 1.08;
+eval "use Test::Pod::Coverage $min_tpc";
+plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage"
+    if $@;
+
+# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
+# but older versions don't recognize some common documentation styles
+my $min_pc = 0.18;
+eval "use Pod::Coverage $min_pc";
+plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
+    if $@;
+
+all_pod_coverage_ok();
diff --git a/t/pod.t b/t/pod.t
new file mode 100644
index 0000000..ee8b18a
--- /dev/null
+++ b/t/pod.t
@@ -0,0 +1,12 @@
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More;
+
+# Ensure a recent version of Test::Pod
+my $min_tp = 1.22;
+eval "use Test::Pod $min_tp";
+plan skip_all => "Test::Pod $min_tp required for testing POD" if $@;
+
+all_pod_files_ok();