package SVL::Command::Tag; use strict; use warnings; use Path::Class; use base qw(SVL::Command); use constant subcommands => qw(list delete); sub run { my ($self, $target, @tags) = @_; my $sharing = SVL::Sharing->new(file($self->svkpath, 'svl-share'), $self->xd); my ($sharing_target, $sharing_path, $sharing_depot) = $self->get_share_args($sharing, $target); my @origtags = $sharing->get_tags( $sharing_target, $sharing_path, $sharing_depot); my %origtags; @origtags{@origtags, @tags} = (); $sharing->set_tags($sharing_target, $target, keys %origtags); $self->SVL::Command::Tag::list::run($target); } sub get_share_args { my $self = shift; my $sharing = shift; my $inpath = shift; my ($share_path, $path, $depot, $target) = $sharing->map_path_to_depot($inpath); $inpath =~s[/(.*?)/][/]; return ($target, $inpath, $depot); } package SVL::Command::Tag::delete; use strict; use warnings; use Path::Class; use base qw(SVL::Command::Tag); sub run { my ($self, $target, @tags) = @_; my $sharing = SVL::Sharing->new(file($self->svkpath, 'svl-share'), $self->xd); my ($sharing_target, $sharing_path, $sharing_depot) = $self->get_share_args($sharing, $target); my @origtags = $sharing->get_tags( $sharing_target, $sharing_path, $sharing_depot); my %origtags; @origtags{@origtags} = (); foreach my $tag (@tags) { delete $origtags{$tag}; } $sharing->set_tags($sharing_target, $target, keys %origtags); $self->SVL::Command::Tag::list::run($target); } package SVL::Command::Tag::list; use strict; use warnings; use Path::Class; use base qw(SVL::Command::Tag); sub run { my ($self, $target) = @_; my $sharing = SVL::Sharing->new(file($self->svkpath, 'svl-share'), $self->xd); print "Tags: " . join (" ", $sharing->get_tags( $self->get_share_args($sharing, $target) )) . "\n"; } 1; __END__ =head1 NAME SVL::Command::Share - Share a local repository =head1 SYNOPSIS svl tag //trunk/Acme-Colour/ tag tag tag svl tag //trunk/Acme-Colour/ --list svl tag //trunk/Acme-Colour/ --delete tag_to_remove =head1 OPTIONS --list # show all tags --delete deletes a given tag