view release on metacpan or  search on metacpan

lib/SVL/Command/Search.pm  view on Meta::CPAN

package SVL::Command::Search;
use strict;
use warnings;
use Path::Class;
use base qw(SVL::Command);
use constant subcommands => (qw(fix));

sub run {
  my ($self, $target) = @_;
  $target ||= "";
  
  my $sharing = SVL::Sharing->new(file($self->svkpath, 'svl-share'), $self->xd);

  my @shares;
  my %local;
  my $bonjour = SVL::Bonjour->new;
  $bonjour->discover;
  foreach my $peer (@{ $bonjour->peers }) {
    foreach my $share (@{ $peer->shares }) {
      next if $target && !grep { $target eq $_ } @{ $share->tags };
      push @shares, $share;
      $local{ $share->uuid } = 1;
    }
  }

  my $opendht;
  eval { $opendht = SVL::OpenDHT->new };
  if ($target && $opendht) {
    foreach my $share ($opendht->show($target)) {
      next if $local{ $share->uuid };
      push @shares, $share;
    }
  }

  my $stale = 0;
  foreach my $share (sort { $a->url cmp $b->url } @shares) {
    print $share->url . " (" . $share->tags_as_string . ")\n";
    my @mirrored = $sharing->mirrored($share);
    foreach my $mirror (@mirrored) {
      print "  mirrored at /" . $mirror->mirror->{target_path} . "\n";
      if ($share->url ne $mirror->url) {
        $stale++;
        if ($self->fix) {
          SVN::Mirror->new(
            target_path => $mirror->mirror->{target_path},
            source      => $share->url,
            repospath   => $mirror->mirror->{repospath},
            repos       => $mirror->mirror->{repos},
            config      => $mirror->mirror->{config},
          )->relocate;
          print "  fixed stale mirror " . $mirror->url . "\n";
        } else {
          print "  stale mirror " . $mirror->url . "\n";
        }
      }
    }
  }
  if ($stale && !$self->fix) {
    print "svl: you have stale mirrors, run svl search --fix $target \n";
  }
}

sub fix {
  0;
}

package SVL::Command::Search::fix;
use base qw(SVL::Command::Search);

sub fix {
  1;
}

1;

__END__

=head1 NAME

SVL::Command::Search - Show shares matching a tag

=head1 SYNOPSIS

  svl search            # show all local shares
  svl search cpan       # show all local/remote shares that match cpan
  svl search --fix      # fix stale mirrors
  svl search --fix cpan # fix stale mirrors

=head1 OPTIONS

None.