File Coverage

blib/lib/Tak.pm
Criterion Covered Total %
statement 6 38 15.7
branch 0 10 0.0
condition 0 3 0.0
subroutine 2 9 22.2
pod 0 4 0.0
total 8 64 12.5


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