view release on metacpan or  search on metacpan

bin/sibs  view on Meta::CPAN

  $moniker =~ s/\./-/g;
  $moniker;
}

sub load_config {
  my $self = shift;
  my $config;

  open my $CONFIG, '<', $self->{config} or die "Cannot read $self->{config}: $! Run '$0 setup'\n";
  $config = join '', <$CONFIG>;
  $config = eval <<"  CONFIG";
    use strict;
    use warnings;
    use File::Basename;
    $config
  CONFIG

  $config or die "Invalid config file: ($@)\n";
  $config->{exclude} ||= [@DEFAULT_EXCLUDE];
  $config->{source}  ||= [$ENV{HOME}];
  $config->{destination} = URI->new($config->{destination} || '');

  @{$self}{keys %$config} = values %$config;

  for my $m (qw( scheme path )) {
    next if $config->{destination}->$m;
    die "[$self->{config}] Missing '$m' part for 'destination' URI\n";
  }

  $config->{destination}->scheme eq 'rsync'
    or die "[$self->{config}] Only rsync:// is supported for 'destination' URI\n";
}

sub run_sibs_remote {
  my ($self, @args) = @_;
  my $stdin = ref $args[0] eq 'CODE' ? shift @args : sub {''};
  my @cmd;

  if (my $remote_host = $self->remote_host) {
    @cmd = ($SSH => '-l' => $self->{destination}->userinfo, $remote_host);
  }

  unshift @args, '--silent'  if $self->{silent};
  unshift @args, '--verbose' if $self->{verbose};
  push @cmd, qq(perl - @args);

  open my $SSH,  '|-', @cmd     or die "Cannot start 'sibs @args' remote: $!";
  open my $SELF, '<',  __FILE__ or die "Cannot read $0: $!";
  print $SSH $_ while <$SELF>;
  print $SSH "\n__DATA__\n";
  print $SSH $self->$stdin;
  close $SSH;    # TODO: do i need to wait?
}

sub ssh_file {
  my ($self, $file) = @_;

  if (!$self->{ssh_dir}) {
    mkdir "$ENV{HOME}/.ssh" or die "Could not mkdir $ENV{HOME}/.ssh: $!" unless -d "$ENV{HOME}/.ssh";
    chmod 0700, "$ENV{HOME}/.ssh";
    $self->{ssh_dir} = "$ENV{HOME}/.ssh";
  }

  return $self->{ssh_dir} unless $file;
  return join '/', $self->{ssh_dir}, $file;
}

sub _backup_name {
  POSIX::strftime($_[0]->{format} || '%d-%H', localtime);
}

sub _log {
  my $self = shift;
  my $min  = (localtime)[1];
  my $hour = (localtime)[2];

  return if $self->{silent};
  warn sprintf "[%02s:%02s] %s\n", $hour, $min, join ' ', @_;
}

sub _read {
  my ($self, $k) = @_;
  my $v = $self->{$k};
  $v = join ' ', @$v if ref $v eq 'ARRAY';
  local $| = 1;
  print $k;
  printf " ($v)", if $v;
  print ": ";
  $_ = <STDIN>;
  chomp;
  $_ ||= $v;
}

sub _system {
  my ($self, $program, @options) = @_;

  for my $path (qw( /bin /usr/bin /usr/local/bin )) {
    next unless -x "$path/$program";
    $program = "$path/$program";
    last;
  }

  $self->_log(join ' ', map { length $_ ? $_ : '""' } $program, @options);
  system $program => @options;
}

sub run {
  my ($self, @args) = @_;
  my $action = 'help';
  my $i      = 0;

  while ($i < @args) {
    $self->{config}  = splice @args, $i, 1, () and next if -f $args[$i];
    $self->{verbose} = splice @args, $i, 1, () and next if $args[$i] =~ /^--?v/;
    $self->{silent}  = splice @args, $i, 1, () and next if $args[$i] =~ /^--?s/;
    $i++;
  }

  $action = shift @args if @args;
  $self->{config} ||= "$ENV{HOME}/.sibs.conf";