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   1463 use Tak::Loop;
  1         2  
  1         29  
4 1     1   6 use strictures 1;
  1         8  
  1         50  
5              
6             our $VERSION = '0.001004'; # 0.1.4
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             my %on_r = map {
34 0           my $orig = $_->{on_result};
  0            
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 (then I wrote Object::Remote)
53              
54             =head1 SYNOPSIS
55              
56             # Curse at mst for doing it again under a different name
57             # Curse at mst some more
58             $ cpanm Object::Remote
59             # Now go use that
60              
61             (sorry, I should've done a tombstone release ages back)
62              
63             bin/tak -h user1@host1 -h user2@host2 exec cat /etc/hostname
64              
65             or
66              
67             in Takfile:
68              
69             package Tak::MyScript;
70            
71             use Tak::Takfile;
72             use Tak::ObjectClient;
73            
74             sub each_get_homedir {
75             my ($self, $remote) = @_;
76             my $oc = Tak::ObjectClient->new(remote => $remote);
77             my $home = $oc->new_object('Path::Class::Dir')->absolute->stringify;
78             $self->stdout->print(
79             $remote->host.': '.$home."\n"
80             );
81             }
82            
83             1;
84              
85             then
86              
87             tak -h something get-homedir
88              
89             =head1 WHERE'S THE REST?
90              
91             A drink leaked in my bag on the way back from LPW. My laptop is finally
92             alive again though so I'll try and turn my slides into a vague attempt
93             at documentation while I'm traveling to/from christmas things.
94              
95             =head1 Example
96              
97             $ cat Takfile
98             package Tak::MyScript;
99              
100             use strict;
101             use warnings;
102              
103             use Tak::Takfile;
104             use Tak::ObjectClient;
105             use lib "./lib";
106              
107             sub each_host {
108             my ($self, $remote) = @_;
109              
110             my $oc = Tak::ObjectClient->new(remote => $remote);
111             my $name = $oc->new_object('My::Hostname');
112             print "Connected to hostname: " . $name . "\n";
113             }
114              
115             1;
116              
117             -----
118              
119             $cat ./lib/My/Hostname
120             package My::Hostname;
121              
122             use Sys::Hostname;
123              
124             sub new {
125             my ($self) = @_;
126             my $name = hostname;
127             return $name;
128             }
129              
130             1;
131              
132             =head1 AUTHOR
133              
134             mst - Matt S. Trout (cpan:MSTROUT)
135              
136             =head1 CONTRIBUTORS
137              
138             None required yet. Maybe this module is perfect (hahahahaha ...).
139              
140             =head1 COPYRIGHT
141              
142             Copyright (c) 2011 the Tak L and L
143             as listed above.
144              
145             =head1 LICENSE
146              
147             This library is free software and may be distributed under the same terms
148             as perl itself.
149              
150             =cut