lib/Tak.pm

   1 package Tak;
   2
   3 use Tak::Loop;
   4 use strictures 1;
   5
   6 our $VERSION = '0.001001'; # 0.1.1
   7
   8 our $loop;
   9
  10 sub loop { $loop ||= Tak::Loop->new }
  11
  12 sub loop_until {
  13   my ($class, $done) = @_;
  14   return if $done;
  15   my $loop = $class->loop;
  16   $loop->loop_once until $_[1];
  17 }
  18
  19 sub await_all {
  20   my ($class, @requests) = @_;
  21   @requests = grep !$_->is_done, @requests;
  22   return unless @requests;
  23   my %req = map +("$_" => "$_"), @requests;
  24   my $done;
  25   my %on_r = map {
  26     my $orig = $_->{on_result};
  27     my $tag = $req{$_};
  28     ($_ => sub { delete $req{$tag}; $orig->(@_); $done = 1 unless keys %req; })
  29   } @requests;
  30   my $call = sub { $class->loop_until($done) };
  31   foreach (@requests) {
  32     my $req = $_;
  33     my $inner = $call;
  34     $call = sub { local $req->{on_result} = $on_r{$req}; $inner->() };
  35   }
  36   $call->();
  37   return;
  38 }
  39
  40 "for lexie";
  41
  42 =head1 NAME
  43
  44 Tak - Multi host remote control over ssh
  45
  46 =head1 SYNOPSIS
  47
  48   bin/tak -h user1@host1 -h user2@host2 exec cat /etc/hostname
  49
  50 or
  51
  52   in Takfile:
  53
  54   package Tak::MyScript;
  55
  56   use Tak::Takfile;
  57   use Tak::ObjectClient;
  58
  59   sub each_get_homedir {
  60     my ($self, $remote) = @_;
  61     my $oc = Tak::ObjectClient->new(remote => $remote);
  62     my $home = $oc->new_object('Path::Class::Dir')->absolute->stringify;
  63     $self->stdout->print(
  64       $remote->host.': '.$home."\n"
  65     );
  66   }
  67
  68   1;
  69
  70 then
  71
  72   tak -h something get-homedir
  73
  74 =head1 WHERE'S THE REST?
  75
  76 A drink leaked in my bag on the way back from LPW. You'll get more once I
  77 get my laptop's drive into an enclosure and decant the slides.
  78
  79 =head1 AUTHOR
  80
  81 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
  82
  83 =head1 CONTRIBUTORS
  84
  85 None required yet. Maybe this module is perfect (hahahahaha ...).
  86
  87 =head1 COPYRIGHT
  88
  89 Copyright (c) 2011 the strictures L</AUTHOR> and L</CONTRIBUTORS>
  90 as listed above.
  91
  92 =head1 LICENSE
  93
  94 This library is free software and may be distributed under the same terms
  95 as perl itself.
  96
  97 =cut