The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
Changes 015
MANIFEST 15
META.json 043
META.yml 2121
MYMETA.json 043
MYMETA.yml 024
lib/BigIP/iControl.pm 18202
t/boilerplate.t 056
8 files changed (This is a version diff) 40409
@@ -1,5 +1,20 @@
 Revision history for BigIP-iControl
 
+0.097	Fri Apr 26 2013 ltp@cpan.org
+	- Added get_ltm_string_class_list method
+
+0.096   Wed Apr 24 2013 ltp@cpan.org
+	- Fixed long64 conversion in statistical routines.
+	- Added methods: 
+		- set_ltm_string_class_member
+		- get_ltm_vs_rules
+		- get_ltm_string_class_members
+	  	- get_ltm_string_class
+		- get_ltm_snat_type
+		- get_ltm_address_class_list
+		- delete_ltm_string_class_member
+		- add_ltm_string_class_member
+
 0.095   Thu Jun 21 2012 ltp@cpan.org
 	- Added two new methods; get_self_ip_list and get_self_ip_vlan.
 
@@ -4,7 +4,11 @@ Makefile.PL
 README
 lib/BigIP/iControl.pm
 t/00-load.t
+t/boilerplate.t
 t/manifest.t
 t/pod-coverage.t
 t/pod.t
-META.yml                                 Module meta-data (added by MakeMaker)
+MYMETA.yml
+MYMETA.json
+META.yml                                 Module YAML meta-data (added by MakeMaker)
+META.json                                Module JSON meta-data (added by MakeMaker)
@@ -0,0 +1,43 @@
+{
+   "abstract" : "A Perl interface to the F5 iControl API",
+   "author" : [
+      "Luke Poskitt <ltp@cpan.org>"
+   ],
+   "dynamic_config" : 1,
+   "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.112621",
+   "license" : [
+      "perl_5"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : "2"
+   },
+   "name" : "BigIP-iControl",
+   "no_index" : {
+      "directory" : [
+         "t",
+         "inc"
+      ]
+   },
+   "prereqs" : {
+      "build" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : 0
+         }
+      },
+      "configure" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : 0
+         }
+      },
+      "runtime" : {
+         "requires" : {
+            "MIME::Base64" : 0,
+            "SOAP::Lite" : 0,
+            "Test::More" : 0
+         }
+      }
+   },
+   "release_status" : "stable",
+   "version" : "0.097"
+}
@@ -1,24 +1,24 @@
---- #YAML:1.0
-name:               BigIP-iControl
-version:            0.095
-abstract:           A Perl interface to the F5 iControl API
+---
+abstract: 'A Perl interface to the F5 iControl API'
 author:
-    - Luke Poskitt <ltp@cpan.org>
-license:            perl
-distribution_type:  module
-configure_requires:
-    ExtUtils::MakeMaker:  0
+  - 'Luke Poskitt <ltp@cpan.org>'
 build_requires:
-    ExtUtils::MakeMaker:  0
-requires:
-    MIME::Base64:  0
-    SOAP::Lite:    0
-    Test::More:    0
-no_index:
-    directory:
-        - t
-        - inc
-generated_by:       ExtUtils::MakeMaker version 6.55_02
+  ExtUtils::MakeMaker: 0
+configure_requires:
+  ExtUtils::MakeMaker: 0
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.112621'
+license: perl
 meta-spec:
-    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
-    version:  1.4
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
+name: BigIP-iControl
+no_index:
+  directory:
+    - t
+    - inc
+requires:
+  MIME::Base64: 0
+  SOAP::Lite: 0
+  Test::More: 0
+version: 0.097
@@ -0,0 +1,43 @@
+{
+   "abstract" : "A Perl interface to the F5 iControl API",
+   "author" : [
+      "Luke Poskitt <ltp@cpan.org>"
+   ],
+   "dynamic_config" : 0,
+   "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.112621",
+   "license" : [
+      "perl_5"
+   ],
+   "meta-spec" : {
+      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+      "version" : "2"
+   },
+   "name" : "BigIP-iControl",
+   "no_index" : {
+      "directory" : [
+         "t",
+         "inc"
+      ]
+   },
+   "prereqs" : {
+      "build" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : 0
+         }
+      },
+      "configure" : {
+         "requires" : {
+            "ExtUtils::MakeMaker" : 0
+         }
+      },
+      "runtime" : {
+         "requires" : {
+            "MIME::Base64" : 0,
+            "SOAP::Lite" : 0,
+            "Test::More" : 0
+         }
+      }
+   },
+   "release_status" : "stable",
+   "version" : "0.097"
+}
@@ -0,0 +1,24 @@
+---
+abstract: 'A Perl interface to the F5 iControl API'
+author:
+  - 'Luke Poskitt <ltp@cpan.org>'
+build_requires:
+  ExtUtils::MakeMaker: 0
+configure_requires:
+  ExtUtils::MakeMaker: 0
+dynamic_config: 0
+generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.112621'
+license: perl
+meta-spec:
+  url: http://module-build.sourceforge.net/META-spec-v1.4.html
+  version: 1.4
+name: BigIP-iControl
+no_index:
+  directory:
+    - t
+    - inc
+requires:
+  MIME::Base64: 0
+  SOAP::Lite: 0
+  Test::More: 0
+version: 0.097
@@ -7,8 +7,9 @@ use Carp qw(confess croak);
 use Exporter;
 use SOAP::Lite;
 use MIME::Base64;
+use Math::BigInt;
 
-our $VERSION    = '0.095';
+our $VERSION    = '0.097';
 
 =head1 NAME
 
@@ -88,8 +89,12 @@ our $modules    = {
 							get_default_pool_name	=> 'virtual_servers',
 							get_destination		=> 'virtual_servers',
 							get_enabled_state	=> 'virtual_servers',
+							get_protocol		=> 'virtual_servers',
 							get_statistics		=> 'virtual_servers',
-							get_all_statistics	=> 0
+							get_all_statistics	=> 0,
+							get_rule		=> 'virtual_servers',
+							get_snat_pool		=> 'virtual_servers',
+							get_snat_type		=> 'virtual_servers'
 							},
 				Pool		=>	{
 							get_list		=> 0,
@@ -109,6 +114,15 @@ our $modules    = {
 							get_object_status	=> 'node_addresses',
 							get_monitor_status	=> 'node_addresses',
 							get_statistics		=> 'node_addresses'
+							},
+				Class		=>	{
+							get_address_class_list	=> 0,
+							get_string_class_list	=> 0,
+							get_string_class	=> 'class_names',
+							get_string_class_member_data_value	=> 'class_members',
+							set_string_class_member_data_value	=> {class_members => 1, values => 1},
+							add_string_class_member	=> 'class_members',
+							delete_string_class_member=> 'class_members',
 							}
 				},
 	Management	=>	{
@@ -121,7 +135,9 @@ our $modules    = {
 							get_authentication	=> 'id_list',
 							get_state		=> 'id_list',
 							get_url			=> 'id_list',
-							get_proxy_url		=> 'id_list'
+							get_proxy_url		=> 'id_list',
+							remove			=> 'id_list',
+							query			=> 'id_list'
 							}
 				},
 	Networking	=>	{
@@ -617,7 +633,7 @@ sub __process_statistics {
 
 	foreach (@{@{$statistics->{statistics}}[0]->{statistics}}) {
 		my $type		= $_->{type};
-		$stat_obj{stats}{$type}	= (($_->{value}{high})<<32)|(abs $_->{value}{low});
+		$stat_obj{stats}{$type}	= Math::BigInt->new("0x" . unpack("H*", pack("N2",$_->{value}{high}, $_->{value}{low})))->bstr;
 	}
 	
 	return %stat_obj
@@ -1482,6 +1498,36 @@ sub get_vs_statistics_stringified {
 	return __process_statistics($self->get_vs_statistics($vs));
 }
 
+=head3 get_ltm_vs_rules ($virtual_server)
+
+=cut
+
+sub get_ltm_vs_rules {
+	my ($self, $vs) = @_;
+	return	map	{ $_->[1] } 
+		sort	{ $a->[0] <=> $b->[0] } 
+		map	{ [ $_->{priority}, $_->{rule_name} ] }
+		@{@{$self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_rule', data => {virtual_servers => [$vs]})}[0]}
+}
+
+=head3 get_ltm_snat_pool ($virtual_server)
+
+=cut
+
+sub get_ltm_snat_pool {
+	my($self, $vs) = @_;
+	return @{$self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_snat_pool', data => {virtual_servers => [$vs]})}[0]
+}
+
+=head3 get_ltm_snat_type ($virtual_server)
+
+=cut
+
+sub get_ltm_snat_type {
+	my($self, $vs) = @_;
+	return @{$self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_snat_type', data => {virtual_servers => [$vs]})}[0]
+}
+
 =head3 get_default_pool_name ($virtual_server)
 
 	print "Virtual Server: $virtual_server\nDefault Pool: ", 
@@ -1493,7 +1539,7 @@ Returns the default pool names for the specified virtual server.
 
 sub get_default_pool_name {
 	my ($self, $vs)=@_;
-	return $self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_default_pool_name', data => {virtual_servers => [$vs]})
+	return @{$self->_request(module => 'LocalLB', interface => 'VirtualServer', method => 'get_default_pool_name', data => {virtual_servers => [$vs]})}[0]
 }
 
 =head3 get_pool_list ()
@@ -1969,6 +2015,118 @@ sub __get_gtm_vs_definition {
 	}
 }
 
+=head3 get_ltm_address_class_list ()
+
+Returns a list of all existing address classes.
+
+=cut
+
+sub get_ltm_address_class_list {
+        return @{ $_[0]->_request(module => 'LocalLB', interface => 'Class', method => 'get_address_class_list') }
+}
+
+=head3 get_ltm_string_class_list ()
+
+Returns a list of all existing string classes.
+
+=cut
+
+sub get_ltm_string_class_list {
+        return @{ $_[0]->_request(module => 'LocalLB', interface => 'Class', method => 'get_string_class_list') }
+}
+
+=head3 get_ltm_string_class ( $class_name )
+
+Return the specified LTM string class.
+
+=cut
+
+sub get_ltm_string_class {
+	my ( $self, $class ) = @_;
+        return @{ $self->_request(module => 'LocalLB', interface => 'Class', method => 'get_string_class', data => { class_names => [ $class ] } ) }[0]->{members}
+}
+
+=head3 get_ltm_string_class_members ( $class )
+
+Returns the specified LTM string class members.
+
+=cut
+
+sub get_ltm_string_class_members {
+	my ( $self, $class ) = @_;
+	return $self->_request( module => 'LocalLB', interface => 'Class', method => 'get_string_class_member_data_value', data => { class_members => 
+        			[ @{ $self->_request(module => 'LocalLB', interface => 'Class', method => 'get_string_class', data => { class_names => [ $class ] } ) }[0] ] } )
+}
+
+=head3 add_ltm_string_class_member ( $class, $member )
+
+Add the provided member to the specified class.
+
+=cut
+
+sub add_ltm_string_class_member {
+	my ( $self, $class, $member ) = @_;
+	$self->_request(	module		=> 'LocalLB',
+				interface	=> 'Class',
+				method		=> 'add_string_class_member',
+				data		=> {
+						class_members	=> [
+								     {
+								   	name	=> $class,
+									members => [ $member ]
+								     }
+								]
+						}
+			)
+}
+
+=head3 delete_ltm_string_class_member ( $class, $member )
+
+Deletes the provided member from the specified class.
+
+=cut
+
+sub delete_ltm_string_class_member {
+	my ( $self, $class, $member ) = @_;
+	$self->_request(	module		=> 'LocalLB',
+				interface	=> 'Class',
+				method		=> 'delete_string_class_member',
+				data		=> {
+						class_members	=> [
+								     {
+								   	name	=> $class,
+									members => [ $member ]
+								     }
+								]
+						}
+			)
+}
+
+=head3 set_ltm_string_class_member ( $class, $member, value )
+
+Sets the value of the member to the provided value in the specified class.
+
+=cut
+
+sub set_ltm_string_class_member {
+	my ( $self, $class, $member, $value ) =	@_;
+	$self->_request(	module 		=> 'LocalLB', 
+				interface	=> 'Class', 
+				method		=> 'set_string_class_member_data_value', 
+				data 		=> {
+						class_members	=> [ 
+								     { 
+									name	=> $class, 
+									members => [ $member ] 
+								     } 
+								   ], 
+						values		=> [ 
+									[ $value ] 
+								   ] 
+						} 
+			)
+}
+
 =head3 get_db_variable ( $VARIABLE )
 
 	# Prints the value of the configsync.state database variable.
@@ -1983,35 +2141,61 @@ sub get_db_variable {
 	return @{$self->_request(module => 'Management', interface => 'DBVariable', method => 'query', data => { variables => [$var] })}[0]->{value}
 }
 
-=head3 get_event_subscription
+=head3 get_event_subscription_list
 
-Returns all registered event subscriptions.
+Returns an array of event subscription IDs for all registered event subscriptions.
 
 =cut 
 
-sub get_event_subscription {
+sub get_event_subscription_list {
 	my ($self, %args)=@_;
 	return $self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_list');
 }
 
+=head3 get_event_subscription
+
+=cut
+
+sub get_event_subscription {
+	my ($self, $id)=@_;
+	return $self->_request(module => 'Management', interface => 'EventSubscription', method => 'query', data => { id_list => [$id] })
+}
+
+=head3 remove_event_subscription
+
+=cut
+
+sub remove_event_subscription {
+	my ($self, $id)=@_;
+	return $self->_request(module => 'Management', interface => 'EventSubscription', method => 'remove', data => { id_list => [$id] })
+}
+
+=head3 get_event_subscription_state
+
+=cut
+
 sub _get_event_subscription_state {
 	my ($self,$id)	= @_;
-	return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_state', data => { id_list => [$id]})}[0]
+	return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_state', data => { id_list => [$id] })}[0]
 }
 
-sub _get_event_subscription_url {
+=head3 get_event_subscription_url
+
+=cut
+
+sub get_event_subscription_url {
 	my ($self,$id)	= @_;
-	return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_url', data => { id_list => [$id]})}[0]
+	return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_url', data => { id_list => [$id] })}[0]
 }
 
 sub _get_event_subscription_proxy_url {
 	my ($self,$id)	= @_;
-	return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_proxy_url', data => { id_list => [$id]})}[0]
+	return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_proxy_url', data => { id_list => [$id] })}[0]
 }
 
 sub _get_event_subscription_authentication {
 	my ($self,$id)	= @_;
-	return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_proxy_url', data => { id_list => [$id]})}[0]
+	return @{$self->_request(module => 'Management', interface => 'EventSubscription', method => 'get_proxy_url', data => { id_list => [$id] })}[0]
 }
 
 sub get_subscription_list {
@@ -2084,8 +2268,8 @@ sub create_subscription_list {
 	my ($self, %args)=@_;
 	$args{name}					or return 'Request error: missing "name" parameter';
 	$args{url}					or return 'Request error: missing "url" parameter';	
-	$args{username}					or return 'Request error: missing "username" parameter';	
-	$args{password}					or return 'Request error: missing "password" parameter';	
+	#$args{username}					or return 'Request error: missing "username" parameter';	
+	#$args{password}					or return 'Request error: missing "password" parameter';	
 	$args{ttl} =~ /^(-)?\d+$/			or return 'Request error: missing or incorrect "ttl" parameter';	
 	$args{min_events_per_timeslice} =~ /^(-)?\d+$/	or return 'Request error: missing or incorrect "min_events_per_timeslice" parameter';	
 	$args{max_timeslice} =~ /^(-)?\d+$/		or return 'Request error: missing or incorrect "max_timeslice" parameter';	
@@ -2100,9 +2284,9 @@ sub create_subscription_list {
 				event_type_list			=> [@{$args{event_type}}],
 				url				=> $args{url},
 				url_credentials			=> {
-									auth_mode	=> 'AUTHMODE_BASIC',
-									username	=> $args{username},
-									password	=> $args{password}
+									auth_mode	=> 'AUTHMODE_NONE',
+									#username	=> $args{username},
+									#password	=> $args{password}
 								},
 				ttl				=> $args{ttl},
 				min_events_per_timeslice	=> $args{min_events_per_timeslice},
@@ -0,0 +1,56 @@
+#!perl -T
+
+use 5.006;
+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/BigIP/iControl.pm');
+
+
+}
+