lib/Tak.pm

   1 package Tak;
   2
   3 use Tak::Loop;
   4 use strictures 1;
   5
   6 our $VERSION = '0.001003'; # 0.1.3
   7
   8 our ($loop, $did_upgrade);
   9
  10 sub loop { $loop ||= Tak::Loop->new }
  11
  12 sub loop_upgrade {
  13   return if $did_upgrade;
  14   require IO::Async::Loop;
  15   my $new_loop = IO::Async::Loop->new;
  16   $loop->pass_watches_to($new_loop) if $loop;
  17   $loop = $new_loop;
  18   $did_upgrade = 1;
  19 }
  20
  21 sub loop_until {
  22   my ($class, $done) = @_;
  23   return if $done;
  24   $class->loop->loop_once until $_[1];
  25 }
  26
  27 sub await_all {
  28   my ($class, @requests) = @_;
  29   @requests = grep !$_->is_done, @requests;
  30   return unless @requests;
  31   my %req = map +("$_" => "$_"), @requests;
  32   my $done;
  33   my %on_r = map {
  34     my $orig = $_->{on_result};
  35     my $tag = $req{$_};
  36     ($_ => sub { delete $req{$tag}; $orig->(@_); $done = 1 unless keys %req; })
  37   } @requests;
  38   my $call = sub { $class->loop_until($done) };
  39   foreach (@requests) {
  40     my $req = $_;
  41     my $inner = $call;
  42     $call = sub { local $req->{on_result} = $on_r{$req}; $inner->() };
  43   }
  44   $call->();
  45   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 Example
  89
  90 $ cat Takfile
  91 package Tak::MyScript;
  92
  93 use strict;
  94 use warnings;
  95
  96 use Tak::Takfile;
  97 use Tak::ObjectClient;
  98 use lib "./lib";
  99
 100 sub each_host {
 101     my ($self, $remote) = @_;
 102
 103     my $oc = Tak::ObjectClient->new(remote => $remote);
 104     my $name = $oc->new_object('My::Hostname');
 105     print "Connected to hostname: " . $name . "\n";
 106     }
 107
 108 1;
 109
 110 -----
 111
 112 $cat ./lib/My/Hostname
 113 package My::Hostname;
 114
 115 use Sys::Hostname;
 116
 117 sub new {
 118     my ($self) = @_;
 119     my $name = hostname;
 120     return $name;
 121     }
 122
 123 1;
 124
 125 =head1 AUTHOR
 126
 127 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 128
 129 =head1 CONTRIBUTORS
 130
 131 None required yet. Maybe this module is perfect (hahahahaha ...).
 132
 133 =head1 COPYRIGHT
 134
 135 Copyright (c) 2011 the Tak L</AUTHOR> and L</CONTRIBUTORS>
 136 as listed above.
 137
 138 =head1 LICENSE
 139
 140 This library is free software and may be distributed under the same terms
 141 as perl itself.
 142
 143 =cut