#!/usr/bin/perl
#
# 17.oct.2006 -sb-
#
# vim:ts=8:sw=4:ai

use warnings;
use strict;
use Net::IP;

=head2 as_string()

   STRING = IPOBJ->as_string(TEMPLATE);

Return an IPv6 address as a string. Rather than returning
just a fully expanded or optimally shortened string, we
use a template for determining which 16-bit groups should
be expanded.

   S:S:S:S:S:S:S:S = Net::IP::short()
   L:L:L:L:L:L:L:L = Net::IP::ip()

=over 2

=item *

Empty positions in the template are filled in as 'S'.

=item * 

The template is case-insensitive.

=item * 

S, SH, SHO, SHOR, SHORT are equivalent.

=item * 

L, LO, LON, LONG are equivalent.

=back

=cut

sub Net::IP::as_string {
    my $self = shift;
    my $template = @_ ? uc shift : '';

    # Expand the template to contain eight letters. Default for missing
    # letters is "S".
    my $c = $template =~ tr/:/:/;
    $template =~ s/^:/S:/;
    $template =~ s/::/":".("S:" x (8-$c))/e; # Expand the magic '::'.
    $template =~ s/S(H(O(R(T)?)?)?)?/S/g;    # Translate to one letter.
    $template =~ s/L(O(N(G)?)?)?/L/g;        # Translate to one letter.

    # Split Template and IP in 16-bit groups.
    my @template = split(':', $template);
    my @ip = split(':', $self->ip);

    # Expand/Shorten each 16-bit group according to the template.
    for (my $i = 0; $i < @template; $i++) {
	if ($template[$i] ne 'L') {
	    $ip[$i] =~ s/^0{1,3}//; # Remove leading 0s.
	}
    }

    # Join modified IP back into one string.
    my $ip = join(':', @ip);

    #### Ripped from Net::IP::ip_compress_address(), minus ####
    #### the misspelled "sequence" ;-)                     ####

    my $reg = '';

    # Find the longest :0:0: sequence
    while (
        $ip =~ m/
        ((?:^|:)     # Find beginning or ':' -> $1
        0(?::0)+     # 0 followed by 1 or several ':0'
        (?::|$))     # ':' or end
        /gx
      )
    {
        $reg = $1 if (length($reg) < length($1));
    }

    # Replace sequence by '::'
    $ip =~ s/$reg/::/ if ($reg ne '');

    #### End rip ####

    return $ip;
}

##############################################################################
# Test script.
##############################################################################
my $template = @ARGV ? shift @ARGV : '::LONG:SHORT';
print "> ";
while (<>) {
    chomp;
    my $ip = new Net::IP($_);
    unless ($ip) {
	print Net::IP::Error, "\n";
	next;
    }
    if ($ip->version != 6) {
	print "Nothing to do\n";
    }
    print $ip->as_string($template), "\n";
}
continue {
    print "> ";
}
print "\n";
