Start of tags file handling

Refactor file loading code into one place since it should all work in a similar way.

Added in tag functionality.
- Cluster files are: tag host host host host
- Tag files are: host tag tag tag

Yes to add in remainder of code to load in the files automatically

Changes

@@ -1,3 +1,7 @@
+????-??-?? Duncan Ferguson <duncan_ferguson@user.sf.net> - v4.02_01
+- Refactured file loading code
+- Add in 'tags' file handling
+
 2013-03-05 Duncan Ferguson <duncan_ferguson@user.sf.net> - v4.01_05
 - New option (-m, --unique-servers) to remove repeated servers when opening terminals (Thanks to Oliver Meissner)
 - Drop MYMETA.yml and .json files from the distribution

MANIFEST

@@ -34,6 +34,7 @@ t/30cluster.cannot_read
 t/30cluster.file1
 t/30cluster.file2
 t/30cluster.t
+t/30cluster.tag1
 t/80clusterssh.t
 t/boilerplate.t
 t/manifest.t

lib/App/ClusterSSH.pm

@@ -3,7 +3,7 @@ package App::ClusterSSH;
 use 5.008.004;
 use warnings;
 use strict;
-use version; our $VERSION = version->new('4.01_05');
+use version; our $VERSION = version->new('4.02_01');
 
 use Carp;
 

lib/App/ClusterSSH/Base.pm

@@ -11,13 +11,14 @@ use Exception::Class (
         fields => 'unknown_config',
     },
     'App::ClusterSSH::Exception::Cluster',
+    'App::ClusterSSH::Exception::LoadFile',
 );
 
 # Dont use SVN revision as it can cause problems
 use version;
 our $VERSION = version->new('0.02');
 
-my $debug_level = 0;
+my $debug_level = 4;
 our $language = 'en';
 our $language_handle;
 our $app_configuration;
@@ -89,7 +90,11 @@ sub set_lang {
 sub set_debug_level {
     my ( $self, $level ) = @_;
     if ( !defined $level ) {
-        croak( App::ClusterSSH::Exception->throw( error => _translate('Debug level not provided') ) );
+        croak(
+            App::ClusterSSH::Exception->throw(
+                error => _translate('Debug level not provided')
+            )
+        );
     }
     if ( $level > 9 ) {
         $level = 9;
@@ -127,7 +132,11 @@ sub config {
     my ($self) = @_;
 
     if ( !$app_configuration ) {
-        croak( App::ClusterSSH::Exception->throw( _translate('config has not yet been set') ) );
+        croak(
+            App::ClusterSSH::Exception->throw(
+                _translate('config has not yet been set')
+            )
+        );
     }
 
     return $app_configuration;
@@ -137,11 +146,19 @@ sub set_config {
     my ( $self, $config ) = @_;
 
     if ($app_configuration) {
-        croak( App::ClusterSSH::Exception->throw( _translate('config has already been set') ) );
+        croak(
+            App::ClusterSSH::Exception->throw(
+                _translate('config has already been set')
+            )
+        );
     }
 
-    if(!$config) { 
+    if ( !$config ) {
-        croak( App::ClusterSSH::Exception->throw( _translate('passed config is empty')) );
+        croak(
+            App::ClusterSSH::Exception->throw(
+                _translate('passed config is empty')
+            )
+        );
     }
 
     $self->debug( 3, _translate('Setting app configuration') );
@@ -151,6 +168,96 @@ sub set_config {
     return $self;
 }
 
+sub load_file {
+    my ( $self, %args ) = @_;
+
+    if ( !$args{filename} ) {
+        croak(
+            App::ClusterSSH::Exception->throw(
+                error => '"filename" arg not passed'
+            )
+        );
+    }
+
+    if ( !$args{type} || $args{type} !~ m/cluster|config/ ) {
+        croak(
+            App::ClusterSSH::Exception->throw(
+                error => '"type" arg invalid'
+            )
+        );
+    }
+
+    $self->debug( 2, 'Loading in config file: ', $args{filename} );
+
+    if ( !-e $args{filename} ) {
+        croak(
+            App::ClusterSSH::Exception::LoadFile->throw(
+                error => $self->loc(
+                    'Unable to read file [_1]: [_2]' . $/,
+                    $args{filename}, $!
+                ),
+            ),
+        );
+    }
+
+    my $regexp
+        = $args{type} eq 'config'  ? qr/\s*(\S+)\s*=\s*(.*)/
+        : $args{type} eq 'cluster' ? qr/\s*(\S+)\s+(.*)/
+        : croak(
+        App::ClusterSSH::Exception::LoadFile->throw(
+            error => 'Unknown arg type: ',
+            $args{type}
+        )
+        );
+
+    open( my $fh, '<', $args{filename} )
+        or croak(
+            App::ClusterSSH::Exception::LoadFile->throw(
+                error => $self->loc("Unable to read file [_1]: [_2]", $args{filename}, $!)
+            ),
+        );
+
+    my %results;
+    my $line;
+
+    while ( defined( $line = <$fh> ) ) {
+        next
+            if ( $line =~ /^\s*$/ || $line =~ /^#/ )
+            ;    # ignore blank lines & commented lines
+
+        $line =~ s/\s*#.*//;  # remove comments from remaining lines
+        $line =~ s/\s*$//;    # remove trailing whitespace
+
+        # look for continuation lines
+        chomp $line;
+        if ( $line =~ s/\\\s*$// ) {
+            $line .= <$fh>;
+            redo unless eof($fh);
+        }
+
+        next unless $line =~ $regexp;
+        my ( $key, $value ) = ( $1, $2 );
+        if ( defined $key && defined $value ) {
+            if($results{$key}) {
+                $results{$key} .= ' '. $value;
+            }else {
+                $results{$key} = $value;
+            }
+            $self->debug( 3, "$key=$value" );
+            $self->debug( 7, "entry now reads: $key=$results{$key}" );
+        }
+    }
+
+    close($fh)
+        or croak(
+        App::ClusterSSH::Exception::LoadFile->throw(
+            error => "Could not close $args{filename} after reading: $!"
+        ),
+        );
+
+    return %results;
+}
+
 1;
 
 =pod
@@ -232,6 +339,11 @@ hasnt been called
 
 Set the config to the given value - croaks if has already been called
 
+=item %results = $obj->load_file( filename => '/path/to/file', type => '(cluster|config}' )
+
+Load in the specified file and return a hash, parsing the file depending on
+wther it is a config file (key = value) or cluster file (key value)
+
 =back
 
 =head1 AUTHOR

lib/App/ClusterSSH/Cluster.pm

@@ -34,40 +34,32 @@ sub get_clusters {
     return $self;
 }
 
+sub read_tag_file {
+    my ( $self, $filename ) = @_;
+    $self->debug( 2, 'Reading tags from file ', $filename );
+    if ( -f $filename ) {
+        my %hosts = $self->load_file( type => 'cluster', filename => $filename);
+        foreach my $host (keys %hosts) {
+            $self->debug(4, "Got entry for $host on tags $hosts{$host}");
+            $self->register_host($host, split(/\s+/, $hosts{$host}));
+        }
+    }
+    else {
+        $self->debug( 2, 'No file found to read');
+    }
+    return $self;
+}
+
 sub read_cluster_file {
     my ( $self, $filename ) = @_;
     $self->debug( 2, 'Reading clusters from file ', $filename );
 
     if ( -f $filename ) {
-        open( my $fh, '<', $filename )
+        my %tags = $self->load_file( type => 'cluster', filename => $filename);
-            || croak(
-            App::ClusterSSH::Exception::Cluster->throw(
-                error => $self->loc(
-                    'Unable to read file [_1]: [_2]',
-                    $filename, $!
-                )
-            )
-            );
 
-        my $line;
+        foreach my $tag (keys %tags) {
-        while ( defined( $line = <$fh> ) ) {
+            $self->register_tag($tag, split(/\s+/, $tags{$tag}));
-            next
-                if ( $line =~ /^\s*$/ || $line =~ /^#/ )
-                ;    # ignore blank lines & commented lines
-            chomp $line;
-            if ( $line =~ s/\\\s*$// ) {
-                $line .= <$fh>;
-                redo unless eof($fh);
-            }
-            my @line = split( /\s+/, $line );
-
-        #s/^([\w-]+)\s*//;               # remote first word and stick into $1
-
-            $self->debug( 3, "read line: $line" );
-            $self->register_tag(@line);
         }
-
-        close($fh);
     }
     else {
         $self->debug( 2, 'No file found to read');
@@ -75,12 +67,27 @@ sub read_cluster_file {
     return $self;
 }
 
+sub register_host {
+    my ( $self, $node, @tags ) = @_;
+    $self->debug( 2, "Registering node $node on tags:", join( ' ', @tags ) );
+
+    foreach my $tag (@tags) {
+        if( $self->{tags}->{$tag} ) {
+        $self->{tags}->{$tag} = [ sort @{ $self->{tags}->{$tag} }, $node ] ;
+        } else {
+            $self->{tags}->{$tag} = [ $node ];
+        }
+        #push(@{ $self->{tags}->{$tag} }, $node);
+    }
+    return $self;
+}
+
 sub register_tag {
     my ( $self, $tag, @nodes ) = @_;
 
     $self->debug( 2, "Registering tag $tag: ", join( ' ', @nodes ) );
 
-    $self->{$tag} = \@nodes;
+    $self->{tags}->{$tag} = \@nodes;
 
     return $self;
 }
@@ -88,11 +95,11 @@ sub register_tag {
 sub get_tag {
     my ( $self, $tag ) = @_;
 
-    if ( $self->{$tag} ) {
+    if ( $self->{tags}->{$tag} ) {
         $self->debug( 2, "Retrieving tag $tag: ",
-            join( ' ', $self->{$tag} ) );
+            join( ' ', $self->{tags}->{$tag} ) );
 
-        return @{ $self->{$tag} };
+        return sort @{ $self->{tags}->{$tag} };
     }
 
     $self->debug( 2, "Tag $tag is not registered" );
@@ -101,7 +108,12 @@ sub get_tag {
 
 sub list_tags {
     my ($self) = @_;
-    return keys(%$self);
+    return sort keys(%{ $self->{tags} });
+}
+
+sub dump_tags {
+    my ($self) = @_;
+    return %{ $self->{tags} };
 }
 
 #use overload (
@@ -142,10 +154,18 @@ Read in /etc/clusters and any other given file name and register the tags found.
 
 Read in the given cluster file and register the tags found
 
+=item $cluster->read_tag_file($filename);
+
+Read in the given tag file and register the tags found
+
 =item $cluster->register_tag($tag,@hosts);
 
 Register the given tag name with the given host names.
 
+=item $cluster->register_host($host,@tags);
+
+Register the given host on the provided tags.
+
 =item @entries = $cluster->get_tag('tag');
 
 Retrieve all entries for the given tag
@@ -154,6 +174,10 @@ Retrieve all entries for the given tag
 
 Return an array of all available tag names
 
+=item %tags = $cluster->dump_tags();
+
+Returns a hash of all tag data.
+
 =back
 
 =head1 AUTHOR

lib/App/ClusterSSH/Config.pm

@@ -183,42 +183,45 @@ sub parse_config_file {
 
     $self->debug( 2, 'Loading in config file: ', $config_file );
 
-    if ( !-e $config_file || !-r $config_file ) {
+#    if ( !-e $config_file || !-r $config_file ) {
-        croak(
+#        croak(
-            App::ClusterSSH::Exception::Config->throw(
+#            App::ClusterSSH::Exception::Config->throw(
-                error => $self->loc(
+#                error => $self->loc(
-                    'File [_1] does not exist or cannot be read' . $/,
+#                    'File [_1] does not exist or cannot be read' . $/,
-                    $config_file
+#                    $config_file
-                ),
+#                ),
-            ),
+#            ),
-        );
+#        );
-    }
+#    }
+#
+#    open( CFG, $config_file ) or die("Couldnt open $config_file: $!");
+#    my $l;
+#    my %read_config;
+#    while ( defined( $l = <CFG> ) ) {
+#        next
+#            if ( $l =~ /^\s*$/ || $l =~ /^#/ )
+#            ;    # ignore blank lines & commented lines
+#        $l =~ s/#.*//;     # remove comments from remaining lines
+#        $l =~ s/\s*$//;    # remove trailing whitespace
+#
+#        # look for continuation lines
+#        chomp $l;
+#        if ( $l =~ s/\\\s*$// ) {
+#            $l .= <CFG>;
+#            redo unless eof(CFG);
+#        }
+#
+#        next unless $l =~ m/\s*(\S+)\s*=\s*(.*)\s*/;
+#        my ( $key, $value ) = ( $1, $2 );
+#        if ( defined $key && defined $value ) {
+#            $read_config{$key} = $value;
+#            $self->debug( 3, "$key=$value" );
+#        }
+#    }
+#    close(CFG);
 
-    open( CFG, $config_file ) or die("Couldnt open $config_file: $!");
-    my $l;
     my %read_config;
-    while ( defined( $l = <CFG> ) ) {
+    %read_config = $self->load_file( type => 'config', filename => $config_file );
-        next
-            if ( $l =~ /^\s*$/ || $l =~ /^#/ )
-            ;    # ignore blank lines & commented lines
-        $l =~ s/#.*//;     # remove comments from remaining lines
-        $l =~ s/\s*$//;    # remove trailing whitespace
-
-        # look for continuation lines
-        chomp $l;
-        if ( $l =~ s/\\\s*$// ) {
-            $l .= <CFG>;
-            redo unless eof(CFG);
-        }
-
-        next unless $l =~ m/\s*(\S+)\s*=\s*(.*)\s*/;
-        my ( $key, $value ) = ( $1, $2 );
-        if ( defined $key && defined $value ) {
-            $read_config{$key} = $value;
-            $self->debug( 3, "$key=$value" );
-        }
-    }
-    close(CFG);
 
     # grab any clusters from the config before validating it
     if ( $read_config{clusters} ) {

t/15config.t

@@ -139,9 +139,9 @@ my $file = "$Bin/$Script.doesntexist";
 trap {
     $config = $config->parse_config_file( $file, );
 };
-isa_ok( $trap->die, 'App::ClusterSSH::Exception::Config' );
+isa_ok( $trap->die, 'App::ClusterSSH::Exception::LoadFile' );
 is( $trap->die,
-    "File $file does not exist or cannot be read" . $/,
+    "Unable to read file $file: No such file or directory" . $/,
     'got correct error message'
 );
 

t/30cluster.t

@@ -22,13 +22,16 @@ isa_ok( $cluster1, 'App::ClusterSSH::Cluster' );
 my $cluster2 = App::ClusterSSH::Cluster->new();
 isa_ok( $cluster2, 'App::ClusterSSH::Cluster' );
 
-my @expected = ( 'pete', 'jo', 'fred' );
+my %expected = ( people => [ 'fred', 'jo', 'pete',  ] );
 
-$cluster1->register_tag( 'people', @expected );
+$cluster1->register_tag( 'people', @{ $expected{people} } );
 
 my @got = $cluster2->get_tag('people');
+is_deeply( \@got, \@{ $expected{people} }, 'Shared cluster object' )
+    or diag explain @got;
+my %got = $cluster2->dump_tags;
 
-is_deeply( \@got, \@expected, 'Shared cluster object' );
+is_deeply( \%got, \%expected, 'Shared cluster object' ) or diag explain %got;
 
 # should pass without issue
 trap {
@@ -46,7 +49,7 @@ if ( $EUID != 0 ) {
         $cluster1->read_cluster_file($no_read);
     };
     chmod 0644, $no_read;
-    isa_ok( $trap->die, 'App::ClusterSSH::Exception::Cluster' );
+    isa_ok( $trap->die, 'App::ClusterSSH::Exception::LoadFile' );
     is( $trap->die,
         "Unable to read file $no_read: Permission denied",
         'Error on reading an existing file ok'
@@ -56,22 +59,38 @@ else {
     pass('Cannot test for lack of read access when run as root');
 }
 
-@expected = ('host1');
+$expected{tag1} = ['host1'];
 $cluster1->read_cluster_file( $Bin . '/30cluster.file1' );
-@got = $cluster1->get_tag('tag1');
+test_expected( 'file 1', %expected );
-is_deeply( \@got, \@expected, 'read simple file OK' );
 
-@expected = ('host1');
+$expected{tag2} = [ 'host2', ];
+$expected{tag3} = [ 'host3', 'host4' ];
 $cluster1->read_cluster_file( $Bin . '/30cluster.file2' );
-@got = $cluster1->get_tag('tag1');
+test_expected( 'file 2', %expected );
-is_deeply( \@got, \@expected, 'read more complex file OK' );
 
-@expected = ('host2');
+$expected{tag10} = [ 'host10', 'host20', 'host30' ];
-@got      = $cluster1->get_tag('tag2');
+$expected{tag20} = [ 'host10', ];
-is_deeply( \@got, \@expected, 'read more complex file OK' );
+$expected{tag30} = [ 'host10', ];
-
+$expected{tag40} = [ 'host20', 'host30', ];
-@expected = ( 'host3', 'host4' );
+$expected{tag50} = [ 'host30', ];
-@got = $cluster1->get_tag('tag3');
+$cluster1->read_tag_file( $Bin . '/30cluster.tag1' );
-is_deeply( \@got, \@expected, 'read more complex file OK' );
+test_expected( 'tag 1', %expected );
 
 done_testing();
+
+sub test_expected {
+    my ( $test, %expected ) = @_;
+
+    foreach my $key ( keys %expected ) {
+        my @got = $cluster2->get_tag($key);
+        is_deeply(
+            \@got,
+            \@{ $expected{$key} },
+            'file ' . $test . ' get_tag on: '. $key
+        ) or diag explain @got;
+    }
+
+    my %got = $cluster1->dump_tags;
+    is_deeply( \%got, \%expected, 'file ' . $test . ' dump_tags' )
+        or diag explain %got;
+}