view release on metacpan or  search on metacpan

lib/App/eachperl.pm  view on Meta::CPAN

method run ( @argv )
{
   my $cinv = Commandable::Invocation->new_from_tokens( @argv );

   $_finder->handle_global_options( $cinv );

   $self->postprocess_config;

   if( $cinv->peek_remaining =~ m/^-/ ) {
      $cinv->putback_tokens( "exec" );
   }

   return $_finder->find_and_invoke( $cinv );
}

method command_list
   :Command_description("List the available perls")
   ()
{
   foreach my $perl ( $self->perls ) {
      my @flags;
      push @flags, $perl->version;
      push @flags, "threads"   if $perl->is_threads;
      push @flags, "DEBUGGING" if $perl->is_debugging;
      push @flags, "devel"     if $perl->is_devel;

      printf "%s%s: %s (%s)\n",
         ( $perl->selected ? "* " : "  " ),
         $perl->name, $perl->fullpath, join( ",", @flags ),
      ;
   }
   return 0;
}

method exec ( @argv )
{
   my %opts = %{ shift @argv } if @argv and ref $argv[0] eq "HASH";

   my @results;
   my $ok = 1;

   my $signal;

   my @perls = $self->perls;
   my $idx = 0;
   foreach ( @perls ) {
      $idx++;
      next unless $_->selected;

      my $perl = $_->name;
      my $path = $_->fullpath;

      my @status = (
         ( $ok
            ? String::Tagged->new_tagged( "-OK-", fg => $COL{grey} )
            : String::Tagged->new_tagged( "FAIL", fg => $COL{red} ) ),

         String::Tagged->new
            ->append( "Running " )
            ->append_tagged( $perl, bold => 1 ),

         ( $idx < @perls
            ? String::Tagged->new_tagged( sprintf( "(%d more)", @perls - $idx ), fg => $COL{grey} )
            : () ),
      );

      $_io_term->set_status(
         String::Tagged->join( " | ", @status )
            ->apply_tag( 0, -1, bg => Convert::Color->new( "vga:blue" ) )
      );

      $opts{oneline}
         ? $_io_term->more_partial( "$BOLD$perl:$RESET " )
         : $_io_term->print_line( "\n$BOLD  --- $perl --- $RESET" );

      my $has_partial = $opts{oneline};
      IPC::Run::run [ $path, @argv ], ">pty>", sub {
         my @lines = split m/\r?\n/, $_[0], -1;

         if( $has_partial ) {
            my $line = shift @lines;

            if( $line =~ s/^\r// ) {
               $_io_term->replace_partial( $line );
            }
            else {
               $_io_term->more_partial( $line );
            }

            if( @lines ) {
               $_io_term->finish_partial;
               $has_partial = 0;
            }
         }

         # Final element will be empty string if it ended in a newline
         my $partial = pop @lines;

         $_io_term->print_line( $_ ) for @lines;

         if( length $partial ) {
            $_io_term->more_partial( $partial );
            $has_partial = 1;
         }
      };

      if( $has_partial ) {
         $_io_term->finish_partial;
      }

      if( $? & 127 ) {
         # Exited via signal
         $signal = $?;
         push @results, [ $perl => "aborted on SIG$SIGNAMES[ $? ]" ];
         last;
      }
      else {
         push @results, [ $perl => $? >> 8 ];
         last if $? and $_stop_on_fail;
      }