/usr/local/CPAN/SVL/SVL/Sharing.pm

• package SVL::Sharing
  • new
  • fakesvkcmd
  • map_path_to_depot
  • set_tags
  • get_tags
  • add
  • delete
  • list
  • resolve_depot_from_path
  • mirrored
  • repos
• EOF

package SVL::Sharing;
use strict;
use warnings;
use base qw(Class::Accessor::Chained::Fast);
use Cwd 'realpath';
use File::Path;
use Path::Class;
use SVN::Core;
use SVN::Repos;
use SVN::Fs;
use SVK;
use Text::Tags::Parser;
__PACKAGE__->mk_accessors(qw(base svk xd));

sub new {
  my $class = shift;
  my $self  = $class->SUPER::new();
  $self->base($_[0]);
  $self->xd($_[1]);
  $self->svk(SVK->new(xd => $self->xd));
  return $self;
}

sub fakesvkcmd {
  my ($self, $path) = @_;
  my $fakecmd = bless { xd => $self->xd }, 'SVK::Command';
  $fakecmd->arg_co_maybe($path, 1);
}

sub map_path_to_depot {
  my ($self, $path, $name) = @_;
  my $target = $self->fakesvkcmd($path);
  my $depot  = $target->depotname;
  die "Cannot find depot '$path'"
    unless (exists($self->xd->{depotmap}->{$depot}));
  $name = $depot unless ($name);
  return (
    file($self->base, $depot || '_default_'),
    $self->xd->{depotmap}->{$depot},
    $depot, $target
  );
}

sub set_tags {
  my ($self, $target, $path, @tags) = @_;
  my $tags = join "\n", @tags;
  $self->svk->ps(
    -m         => "tags for share $target->{depotpath} by svl",
    'svl:tags' => $tags,
    $path,
  );
}

sub get_tags {
  my ($self, $target, $path, $depot) = @_;
  my $tags = $self->xd->do_proplist($target->new(path => $path))->{'svl:tags'}
    || '';
  return Text::Tags::Parser->new->parse_tags(join " ", split "\n", $tags);
}

sub add {
  my ($self, $inpath, @tags) = @_;
  my ($share_path, $path, $depot, $target) =
    $self->map_path_to_depot($inpath, @tags);
  die "$target->{depotpath} doesn't exist.\n"
    unless $target->root->check_path($target->path);
  mkpath([ $self->base ]) unless -d $self->base;

  $self->set_tags($target, $inpath, @tags);

  my @prop =
    split(/\n/,
    $self->xd->do_proplist($target->new(path => '/'))->{'svl:share'} || '');
    lstat $share_path;

  die "$share_path already exists\n" if -e _ && @prop == 0;
  symlink $path => $share_path;
  print "Depot '$depot' is now shared\n";
  push @prop, $target->path;
  $self->svk->ps(
    -m => "share $target->{depotpath} by svl",
    'svl:share' => join("\n", @prop),
    "/$depot/"
  );
}

sub delete {
  my $self = shift;
  my ($share_path, $path, $depot, $target) = $self->map_path_to_depot(@_);

  my @prop =
    split(/\n/,
    $self->xd->do_proplist($target->new(path => '/'))->{'svl:share'} || '');
  @prop = grep { $_ ne $target->path } @prop;
  $self->svk->ps(
    -m => "unshare $target->{depotpath} by svl",
    'svl:share' => join("\n", @prop),
    "/$depot/"
  );

  print "Directory '" . $target->path . "' is now unshared\n";
  unless (@prop) {
    lstat $share_path;
    die "'$depot' isn't shared\n" unless -e _;
    unlink($share_path);
    print "Depot '$depot' is now unshared\n";
  }
}

sub list {
  my $self = shift;
  my $base = $self->base;
  my @shares;
  my $pool = SVN::Pool->new_default;
  for my $link (<$base/*>) {
    my $path = $link;
    my $depot = file($link)->basename;
    my $depotname = $self->resolve_depot_from_path($path);
    next unless defined $depotname;
    my $target = $self->fakesvkcmd("/$depotname/");
    my @prop   =
      split(/\n/, $self->xd->do_proplist($target)->{'svl:share'} || '');

    #    warn "$base $path $depotname : @prop";
    foreach my $prop (@prop) {
      my @tags = $self->get_tags($target, $prop, $depotname);
      push @shares,
        SVL::Share->new({
          depot => $depot,
          path => $prop,
          tags => \@tags,
          uuid => $target->{repos}->fs->get_uuid,
        });
    }
  }
  return @shares;
}

sub resolve_depot_from_path {
  my ($self, $path) = @_;
  $path = realpath($path);
  for (keys %{ $self->xd->{depotmap} }) {
    if ($self->xd->{depotmap}{$_} eq $path) {
      return $_;
    }
  }
  return;
}

sub mirrored {
  my($self, $share) = @_;
  my @paths;
  for my $mirror (
     SVL::Mirror->find_by_uuid(
       xd   => $self->xd,
       uuid => $share->uuid,
     )
     )
   {
     next unless $share->path eq $mirror->mirror->{rsource_path};
    push @paths, $mirror;
  }
  return @paths;
}

# return repos from given depot name or svl::share::depot object;
sub repos {
  my ($self, $path) = @_;
  if (ref($path)) {
    $path = file($self->base, $path->name);
  }
  return SVN::Repos::open($path);
}

1;