"Fossies" - the Fresh Open Source Software Archive

Member "clusterssh-4.16/lib/App/ClusterSSH/Helper.pm" (20 Jun 2020, 3681 Bytes) of package /linux/privat/clusterssh-4.16.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Helper.pm" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 4.15_vs_4.16.

    1 use strict;
    2 use warnings;
    3 
    4 package App::ClusterSSH::Helper;
    5 
    6 # ABSTRACT: ClusterSSH::Helper - Object representing helper script
    7 
    8 =head1 SYNOPSIS
    9 
   10 =head1 DESCRIPTION
   11 
   12 Object representing application configuration
   13 
   14 =cut
   15 
   16 use Carp;
   17 use Try::Tiny;
   18 
   19 use base qw/ App::ClusterSSH::Base /;
   20 
   21 sub new {
   22     my ( $class, %args ) = @_;
   23 
   24     my $self = $class->SUPER::new(%args);
   25 
   26     return $self;
   27 }
   28 
   29 sub script {
   30     my ( $self, $config ) = @_;
   31 
   32     if (   !defined $config
   33         || !ref $config
   34         || ref $config ne "App::ClusterSSH::Config" )
   35     {
   36         croak(
   37             App::ClusterSSH::Exception::Helper->throw(
   38                 error => 'No configuration provided or in wrong format',
   39             ),
   40         );
   41     }
   42 
   43     foreach my $arg ( "comms", $config->{comms}, $config->{comms} . '_args',
   44         'command', 'auto_close' )
   45     {
   46         if ( !defined $config->{$arg} ) {
   47             croak(
   48                 App::ClusterSSH::Exception::Helper->throw(
   49                     error => "Config '$arg' not provided",
   50                 ),
   51             );
   52         }
   53     }
   54 
   55     my $command_pre    = $config->{command_pre}  || q{};
   56     my $command_post   = $config->{command_post} || q{};
   57     my $comms          = $config->{ $config->{comms} };
   58     my $comms_args     = $config->{ $config->{comms} . '_args' };
   59     my $config_command = $config->{command};
   60     my $autoclose      = $config->{auto_close};
   61 
   62     my $postcommand
   63         = $autoclose
   64         ? "echo Sleeping for $autoclose seconds; sleep $autoclose"
   65         : "echo Press RETURN to continue; read IGNORE"
   66         ;    # : "sleep $autoclose";
   67 
   68     my $script = <<"    HERE";
   69            my \$pipe=shift;
   70            my \$svr=shift;
   71            my \$user=shift;
   72            my \$port=shift;
   73            my \$mstr=shift;
   74            my \$command="$command_pre $comms $comms_args ";
   75            open(PIPE, ">", \$pipe) or die("Failed to open pipe: \$!\\n");
   76            print PIPE "\$\$:\$ENV{WINDOWID}"
   77                or die("Failed to write to pipe: $!\\n");
   78            close(PIPE) or die("Failed to close pipe: $!\\n");
   79            if(\$svr =~ m/==\$/)
   80            {
   81                \$svr =~ s/==\$//;
   82                warn("\\nWARNING: failed to resolve IP address for \$svr.\\n\\n"
   83                );
   84                sleep 5;
   85            }
   86            if(\$mstr) {
   87                unless("$comms" ne "console") {
   88                    \$mstr = \$mstr ? "-M \$mstr " : "";
   89                    \$command .= \$mstr;
   90                }
   91            }
   92            if(\$user) {
   93                unless("$comms" eq "telnet") {
   94                    \$user = \$user ? "-l \$user " : "";
   95                    \$command .= \$user;
   96                }
   97            }
   98            if("$comms" eq "telnet") {
   99                \$command .= "\$svr \$port";
  100            } else {
  101                if (\$port) {
  102                    \$command .= "-p \$port \$svr";
  103                } else {
  104                  \$command .= "\$svr";
  105                }
  106            }
  107            if("$config_command") {
  108             \$command .= " \\\"$config_command\\\"";
  109            }
  110            \$command .= "$command_post";
  111            \$command .= " ; $postcommand";
  112            # provide some info for debugging purposes
  113            warn("Running: \$command\\n");
  114            exec(\$command);
  115     HERE
  116 
  117     $self->debug( 4, $script );
  118     $self->debug( 2, 'Helper script done' );
  119 
  120     return $script;
  121 }
  122 
  123 #use overload (
  124 #    q{""} => sub {
  125 #        my ($self) = @_;
  126 #        return $self->{hostname};
  127 #    },
  128 #    fallback => 1,
  129 #);
  130 
  131 1;
  132 
  133 =head1 METHODS
  134 
  135 =over 4
  136 
  137 =item $host=ClusterSSH::Helper->new ({ })
  138 
  139 Create a new helper object.
  140 
  141 =item $host=ClusterSSH::Helper->script ({ })
  142 
  143 Return the helper script
  144 
  145 =back