—

              
package Dist::Joseki::SVK;
use strict;
use warnings;
use Module::Changes;
use Dist::Joseki::SVK::Status;
our $VERSION = '0.17';
use base qw(Dist::Joseki::Base);
__PACKAGE__->mk_scalar_accessors(qw(tag_base changes_filename));
sub dist_current_version_is_tagged {
    my $self = shift;
    $self->assert_is_dist_base_dir;
    my $changes =
        Module::Changes->make_object_for_type('parser_yaml')
        ->parse_from_file($self->changes_filename);
    my $version = $changes->newest_release->version;
    my $name    = $changes->name;
    $self->svk_has_tagged_version($name, $version);
}
sub svk_has_tagged_version {
    my ($self, $name, $version) = @_;
    unless ($self->{svk_tag_cache}) {
        my @tags = $self->read_from_cmd('svk ls ' . $self->tag_base);
        chomp @tags;
        s{/$}{} for @tags;
        $self->{svk_tag_cache}{$_} = 1 for @tags;
    }
    exists $self->{svk_tag_cache}{"$name-$version"};
}
sub status {
    my $self = shift;
    chomp(my @status = $self->read_from_cmd('svk status'));
    my $status = Dist::Joseki::SVK::Status->new;
    for my $status_line (@status) {
        my ($type, $file);
        if ($status_line =~ /^(.)\s+(.*)/) {
            ($type, $file) = ($1, $2);
        } else {
            die "can't parse svk status line:\n$status_line\n";
        }
        next if $file =~ /\.swp$/;
        if ($type eq 'M') {
            $status->modified_push($file);
        } elsif ($type eq 'A') {
            $status->added_push($file);
        } elsif ($type eq 'D') {
            $status->deleted_push($file);
        } elsif ($type eq '?') {
            $status->unversioned_push($file);
        } else {
            die "unknown svk status in line:$status_line\n"
        }
    }
    $status;
}
sub add {
    my ($self, @files) = @_;
    my $files = join ' ' => @files;
    $self->safe_system("svk add $files");
}
1;
__END__
HideShow 119 lines of Pod
=head1 NAME
Dist::Joseki::SVK - Class to interact with svk
=head1 SYNOPSIS
    Dist::Joseki::SVK->new;
=head1 DESCRIPTION
None yet.
=head1 METHODS
=over 4
=item changes_filename
    my $value = $obj->changes_filename;
    $obj->changes_filename($value);
A basic getter/setter method. If called without an argument, it returns the
value. If called with a single argument, it sets the value.
=item changes_filename_clear
    $obj->changes_filename_clear;
Clears the value.
=item clear_changes_filename
    $obj->clear_changes_filename;
Clears the value.
=item clear_tag_base
    $obj->clear_tag_base;
Clears the value.
=item tag_base
    my $value = $obj->tag_base;
    $obj->tag_base($value);
A basic getter/setter method. If called without an argument, it returns the
value. If called with a single argument, it sets the value.
=item tag_base_clear
    $obj->tag_base_clear;
Clears the value.
=back
Dist::Joseki::SVK inherits from L<Dist::Joseki::Base>.
The superclass L<Dist::Joseki::Base> defines these methods and functions:
    new(), assert_is_dist_base_dir(), print_header(), read_from_cmd(),
    safe_system()
The superclass L<Class::Accessor::Complex> defines these methods and
functions:
    mk_abstract_accessors(), mk_array_accessors(), mk_boolean_accessors(),
    mk_class_array_accessors(), mk_class_hash_accessors(),
    mk_class_scalar_accessors(), mk_concat_accessors(),
    mk_forward_accessors(), mk_hash_accessors(), mk_integer_accessors(),
    mk_new(), mk_object_accessors(), mk_scalar_accessors(),
    mk_set_accessors(), mk_singleton()
The superclass L<Class::Accessor> defines these methods and functions:
    _carp(), _croak(), _mk_accessors(), accessor_name_for(),
    best_practice_accessor_name_for(), best_practice_mutator_name_for(),
    follow_best_practice(), get(), make_accessor(), make_ro_accessor(),
    make_wo_accessor(), mk_accessors(), mk_ro_accessors(),
    mk_wo_accessors(), mutator_name_for(), set()
The superclass L<Class::Accessor::Installer> defines these methods and
functions:
    install_accessor()
=head1 BUGS AND LIMITATIONS
No bugs have been reported.
Please report any bugs or feature requests through the web interface at
L<http://rt.cpan.org>.
=head1 INSTALLATION
See perlmodinstall for information and options on installing Perl modules.
=head1 AVAILABILITY
The latest version of this module is available from the Comprehensive Perl
Archive Network (CPAN). Visit <http://www.perl.com/CPAN/> to find a CPAN
site near you. Or see <http://www.perl.com/CPAN/authors/id/M/MA/MARCEL/>.
=head1 AUTHORS
Marcel GrE<uuml>nauer, C<< <marcel@cpan.org> >>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2008 by the authors.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut