xcat-core/perl-xCAT/xCAT/Common.pm

# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html

#This contains functions common to most plugins

package xCAT::Common;

use File::stat;
use File::Copy;
use xCAT::Usage;
use Thread qw/yield/;
use Storable qw/store_fd fd_retrieve/;

BEGIN
{
      $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : '/opt/xcat';
}


# forward_data is a function used to aggregate output passed up from a set of 
# children.  This is commonly used due to make absolutely certain multiple 
# writers trying to use a common file descriptor wouldn't corrupt each other.
# So instead, each child is given a dedicated filehandle and the parent 
# uses this function to organize child data and send it up.
# locking might be a more straightforward approach, but locking experiments
# weren't as successful.
sub forward_data {
  my $callback = shift;
  my $fds = shift;
  my @ready_fds = $fds->can_read(1);
  my $rfh;
  my $rc = @ready_fds;
  foreach $rfh (@ready_fds) {
    my $responses;
    eval {
    	$responses = fd_retrieve($rfh);
    };
    if ($@ and $@ =~ /^Magic number checking on storable file/) { #this most likely means we ran over the end of available input
      $fds->remove($rfh);
      close($rfh);
    } else {
      eval { print $rfh "ACK\n"; }; #Ignore ack loss due to child giving up and exiting, we don't actually explicitly care about the acks
      foreach (@$responses) {
        $callback->($_);
      }
    }
  }
  yield(); #Try to avoid useless iterations as much as possible
  return $rc;
}

#This function pairs with the above.
#It either accepts pre-structured responses or the common ':' delimeted description/value pairs
#for example:
#  send_data('n1',"Temperature: cold","Voltage: normal"); #report normal text, two pieces of data
#  send_data('n1',[1,"Timeout communicationg with foobar]); #Report an error with a code
#  send_data({<custom response packet>},{<other custome response>});
sub send_data {
    my $node;
    if (not ref $_[0]) {
        $node = shift;
    }
    foreach(@_) {
      my %output;
      if (ref($_) eq HASH) {
	  store_fd([$_],$out);
          yield();
          waitforack($out);
          next;
      }
      my $line;
      my $rc;
      if (ref($_) eq ARRAY) {
          $rc = $_->[0];
          $line = $_->[1];
      } else {
          $line = $_;
      }

      
      (my $desc,my $text) = split (/:/,$line,2);
      unless ($text) {
        $text=$desc;
      } else {
        $desc =~ s/^\s+//;
        $desc =~ s/\s+$//;
        if ($desc) {
          $output{node}->[0]->{data}->[0]->{desc}->[0]=$desc;
        }
      }
      $text =~ s/^\s+//;
      $text =~ s/\s+$//;
      $output{node}->[0]->{name}->[0]=$node;
      if ($rc) {
          $output{node}->[0]->{errorcode} = $rc;
          $output{node}->[0]->{error}->[0]->{contents}->[0]=$text;
      } else {
          $output{node}->[0]->{data}->[0]->{contents}->[0]=$text;
      }
      store_fd([\%output],$out);
      yield();
      waitforack($out);
    }
}

#This function is intended to be used to process a request through the usage
#module.
sub usage_noderange { 
  my $request = shift;
  my $callback=shift;

  #display usage statement if -h is present or no noderage is specified
  my $noderange = $request->{node}; #Should be arrayref
  my $command = $request->{command}->[0];
  my $extrargs = $request->{arg};
  my @exargs=($request->{arg});
  if (ref($extrargs)) {
    @exargs=@$extrargs;
  }

  my $usage_string=xCAT::Usage->parseCommand($command, @exargs);
  if ($usage_string) {
    $callback->({data=>$usage_string});
    $request = {};
    return;
  }

  if (!$noderange) {
    $usage_string="Missing Noderange\n";
    $usage_string .=xCAT::Usage->getUsage($command);
    $callback->({error=>[$usage_string],errorcode=>[1]});
    $request = {};
    return;
  }   
}

# copy, overwriting only if the source file is newer
sub copy_if_newer {
  my ($source, $dest) = @_;

  die "ERROR: source file doesn't exist\n" unless (-e $source);

  # resolve destination path
  if ($dest =~ m/\/$/ || -d $dest) {
    $dest .= '/' if ($dest !~ m/\/$/);
    $dest .= $1 if $source =~ m/([^\/]+)$/;
  }

  if (-e $dest) {
    my $smtime = stat($source)->mtime;
    my $dmtime = stat($dest)->mtime;

    return if ($smtime < $dmtime);
  }

  copy($source, $dest);
}

1;