File Coverage

blib/lib/Metabrik/String/Hostname.pm

Criterion	Covered	Total	%
statement	9	35	25.7
branch	0	10	0.0
condition	0	3	0.0
subroutine	3	5	60.0
pod	1	2	50.0
total	13	55	23.6

#
# $Id$
#
# string::hostname Brik
#
package Metabrik::String::Hostname;
use strict;
use warnings;

use base qw(Metabrik);

sub brik_properties {
   return {
      revision => '$Revision$',
      tags => [ qw(unstable fqdn domain) ],
      author => 'GomoR ',
      license => 'http://opensource.org/licenses/BSD-3-Clause',
      attributes => {
         hostname => [ qw(hostname) ],
      },
      commands => {
         parse => [ qw(hostname|OPTIONAL) ],
      },
   };
}

sub parse {
   my $self = shift;
   my ($hostname) = @_;

   $hostname ||= $self->hostname;
   $self->brik_help_run_undef_arg('parse', $hostname) or return;

   my $tld = '';
   my $domain = '';
   my $host = '';
   my @subdomain_list = ();
   my @toks = split('\.', $hostname);
   if (@toks == 1) {
      $host = $toks[0];
   }
   elsif (@toks == 2) {
      $tld = $toks[1];
      $domain = $toks[0].'.'.$tld;
   }
   elsif (@toks == 3) {
      $tld = $toks[2];
      $domain = $toks[1].'.'.$tld;
      $host = $toks[0];
   }
   elsif (@toks > 3) {
      $tld = $toks[-1];
      $domain = $toks[-2].'.'.$tld;
      $host = $toks[0];
      my $count = @toks - 3;
      my $last = $domain;
      for my $t (reverse 1..$count) {
         $last = $toks[$t].'.'.$last;
         push @subdomain_list, $last;
      }
   }

   return {
      host => $host,
      domain => $domain,
      subdomain_list => \@subdomain_list,
      tld => $tld,
   };
}

1;

__END__