Alternative IPv6 address port

Allow for parsing ports from 'xxxx:xxxx:xxxx:xxxx/pppp' style IPv6 addresses

Changes

@@ -1,5 +1,6 @@
 4.03_01 2014-??-?? Duncan Ferguson <duncan_ferguson@user.sf.net>
-[Options changes]
+- Amended host parsing to include alternative IPv6 address port definitions, e.g. 1:2:3:4/5567
+[NOTE: Some options have changed!]
 - Rework options code
 4.02_04 2014-05-17 Duncan Ferguson <duncan_ferguson@user.sf.net>
 - Amend 'Changes' file format to match CPAN specs (see CPAN::Changes)

lib/App/ClusterSSH/Host.pm

@@ -216,16 +216,16 @@ sub parse_host_string {
         $username = $1 || q{};
     }
 
-    # Cannot check for a port with this type of IPv6 string
-    #if ( $host_string =~ s/\A(?::(\d+)\A)// ) {
-    #   $port = $1 || q{};
-    #}
-
     # check for any geometry settings
     if ( $host_string =~ s/(?:=(.*?)$)// ) {
         $geometry = $1 || q{};
     }
 
+    # Check for a '/nnnn' port definition 
+    if ( $host_string =~ s!(?:/(\d+)$)!! ) {
+       $port = $1 || q{};
+    }
+
     # use number of colons as a possible indicator
     my $colon_count = $host_string =~ tr/://;
 
@@ -277,7 +277,7 @@ sub parse_host_string {
             type         => 'ipv6',
         );
     }
-    else {
+    elsif ( $colon_count == 9 ) {
         if ( $host_string =~ s/:(\d+)\A// ) {
             $port = $1;
         }
@@ -302,8 +302,6 @@ sub parse_host_string {
         );
     }
 
-    # Due to above rules, we'll never get this far anyhow
-
     # if we got this far, we didnt parse the host_string properly
     croak(
         App::ClusterSSH::Exception->throw(

t/10host.t

@@ -309,6 +309,14 @@ my %parse_tests = (
         type     => 'ipv6',
         stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
     },
+    '::1/2323' => {
+        hostname => '::1',
+        port     => 2323,
+        username => q{},
+        realname => '::1',
+        geometry => q{},
+        type     => 'ipv6',
+    },
     '::1:2323=3x3+3+3' => {
         hostname => '::1:2323',
         port     => q{},
@@ -318,6 +326,14 @@ my %parse_tests = (
         type     => 'ipv6',
         stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
     },
+    '::1/2323=3x3+3+3' => {
+        hostname => '::1',
+        port     => 2323,
+        username => q{},
+        realname => '::1',
+        geometry => '3x3+3+3',
+        type     => 'ipv6',
+    },
     'user@::1' => {
         hostname => '::1',
         port     => q{},
@@ -335,6 +351,14 @@ my %parse_tests = (
         type     => 'ipv6',
         stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
     },
+    'user@::1/4242' => {
+        hostname => '::1',
+        port     => 4242,
+        username => 'user',
+        realname => '::1',
+        geometry => q{},
+        type     => 'ipv6',
+    },
     'user@::1=5x5+5+5' => {
         hostname => '::1',
         port     => q{},
@@ -352,6 +376,14 @@ my %parse_tests = (
         type     => 'ipv6',
         stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
     },
+    'user@::1/4242=5x5+5+5' => {
+        hostname => '::1',
+        port     => 4242,
+        username => 'user',
+        realname => '::1',
+        geometry => '5x5+5+5',
+        type     => 'ipv6',
+    },
     '[::1]' => {
         hostname => '::1',
         port     => q{},
@@ -448,6 +480,14 @@ my %parse_tests = (
         geometry => q{},
         type     => 'ipv6',
     },
+    '2001:0db8:85a3:0000:0000:8a2e:0370:7334/22' => {
+        hostname => '2001:0db8:85a3:0000:0000:8a2e:0370:7334',
+        port     => 22,
+        username => q{},
+        realname => '2001:0db8:85a3:0000:0000:8a2e:0370:7334',
+        geometry => q{},
+        type     => 'ipv6',
+    },
     '[2001:0db8:85a3:0000:0000:8a2e:0370:7334]' => {
         hostname => '2001:0db8:85a3:0000:0000:8a2e:0370:7334',
         port     => q{},
@@ -497,6 +537,15 @@ my %parse_tests = (
         type     => 'ipv6',
         stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
     },
+    '2001:0db8:85a3::8a2e:0370/7334' => {
+        hostname => '2001:0db8:85a3::8a2e:0370',
+        port     => 7334,
+        username => q{},
+        realname => '2001:0db8:85a3::8a2e:0370',
+        geometry => q{},
+        type     => 'ipv6',
+        stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
+    },
     'pete@2001:0db8:85a3::8a2e:0370:7334' => {
         hostname => '2001:0db8:85a3::8a2e:0370:7334',
         port     => q{},
@@ -506,6 +555,15 @@ my %parse_tests = (
         type     => 'ipv6',
         stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
     },
+    'pete@2001:0db8:85a3::8a2e:0370/7334' => {
+        hostname => '2001:0db8:85a3::8a2e:0370',
+        port     => 7334,
+        username => 'pete',
+        realname => '2001:0db8:85a3::8a2e:0370',
+        geometry => q{},
+        type     => 'ipv6',
+        stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
+    },
     'pete@2001:0db8:85a3::8a2e:0370:7334=2x3+4+5' => {
         hostname => '2001:0db8:85a3::8a2e:0370:7334',
         port     => q{},
@@ -515,6 +573,15 @@ my %parse_tests = (
         type     => 'ipv6',
         stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
     },
+    'pete@2001:0db8:85a3::8a2e:0370/7334=2x3+4+5' => {
+        hostname => '2001:0db8:85a3::8a2e:0370',
+        port     => 7334,
+        username => 'pete',
+        realname => '2001:0db8:85a3::8a2e:0370',
+        geometry => '2x3+4+5',
+        type     => 'ipv6',
+        stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
+    },
     '2001:0db8:85a3::8a2e:0370:7334=2x3+4+5' => {
         hostname => '2001:0db8:85a3::8a2e:0370:7334',
         port     => q{},
@@ -524,6 +591,15 @@ my %parse_tests = (
         type     => 'ipv6',
         stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
     },
+    '2001:0db8:85a3::8a2e:0370/7334=2x3+4+5' => {
+        hostname => '2001:0db8:85a3::8a2e:0370',
+        port     => 7334,
+        username => q{},
+        realname => '2001:0db8:85a3::8a2e:0370',
+        geometry => '2x3+4+5',
+        type     => 'ipv6',
+        stderr   => qr{Ambiguous host string:.*Assuming you meant}ms
+    },
     '[2001:0db8:85a3::8a2e:0370:7334]' => {
         hostname => '2001:0db8:85a3::8a2e:0370:7334',
         port     => q{},
@@ -556,25 +632,48 @@ my %parse_tests = (
         geometry => '2x3+4+5',
         type     => 'ipv6',
     },
+    'pete@[2001:0db8:8a2e:0370:7334]' => {
+        hostname => '2001:0db8:8a2e:0370:7334',
+        port     => q{},
+        username => 'pete',
+        realname => '2001:0db8:8a2e:0370:7334',
+        geometry => q{},
+        type     => 'ipv6',
+    },
+    'some.random:host|string:rubbish' => {
+        die      => qr{Unable to parse hostname from}ms,
+    },
 );
 
 foreach my $ident ( keys(%parse_tests) ) {
+    $host = undef;
     trap {
         $host = App::ClusterSSH::Host->parse_host_string($ident);
     };
-    is( $trap->leaveby, 'return', 'returned ok' );
 
-    #is( $trap->die,     undef,    'returned ok' );
+    if ( $parse_tests{$ident}{die} ) {
-    #is( $trap->stdout,  q{},      'no stdout' );
+        is( $trap->leaveby, 'die', $ident . ' died correctly' );
-    #is( $trap->stderr,  q{},      'no stderr' );
+        like( $trap->die, $parse_tests{$ident}{die}, $ident . ' died correctly' );
+        next;
+    }
+
+    is( $trap->leaveby, 'return', $ident . ' returned correctly' );
+    is( $host, $parse_tests{$ident}{hostname}, 'stringify works on: '.$ident );
+
     isa_ok( $host, "App::ClusterSSH::Host" );
-    is( $host, $parse_tests{$ident}{hostname}, 'stringify works' );
 
-    for my $trap_undef (qw/ die /) {
+    for my $trap_type (qw/ die /) {
-        is( $trap->$trap_undef,
+        if ( ! $parse_tests{$ident}{$trap_type} ) {
-            $parse_tests{$ident}{$trap_undef},
+            is( $trap->$trap_type,
-            "$ident $trap_undef"
+                $parse_tests{$ident}{$trap_type},
+                "$ident $trap_type"
             );
+        } else {
+            like( $trap->$trap_type,
+                $parse_tests{$ident}{$trap_type},
+                "$ident $trap_type"
+            );
+        }
     }
 
     for my $trap_empty (qw/ stdout stderr /) {