1
\$\begingroup\$

Code running with subversion.

example using

my $svn ||= VCS::SVN->new({
    global          => { '--non-interactive' => 1},
    host            => 'file:///Users/vladmirkos/work/IAP/SVN/tmp/test_svn',
    local           => '/Users/vladmirkos/work/IAP/SVN/tmp',
    NameRepository  => 'mine',
});

$svn->checkout;
my $content = `cat $0`;
write_file("/Users/vladmirkos/work/IAP/SVN/tmp/mine/test.pl", $content);

$svn->add;
$svn->commit;
write_file("/Users/vladmirkos/work/IAP/SVN/tmp/mine/test.pl", 'diff');
$svn->commit;
$svn->diff({ '--revision'=> "1:2"});
$svn->copy({ 'test.pl', 'test_copy.pl' });
$svn->status; 





package VCS::SVN;
use strict;
use warnings;
use 5.010;
use Carp;
use Cwd;
use constant {
  TRUE => 1,
  FALSE => 0,
};

our $VERSION = '1.0';

my @comand = qw(
    add
    auth
    blame
    cat
    changelist
    checkout
    cleanup
    commit
    copy
    delete
    diff
    export
    help
    import
    info
    list
    lock
    log
    merge
    mergeinfo
    mkdir
    move
    patch
    propdel
    propedit
    propget
    proplist
    propset
    relocate
    resolve
    resolved
    revert
    status
    switch
    unlock
    update
    upgrade
);

sub __mode_options {
    my ($options, $curr) = @_;

    # TODO: атрибуты класса, добовляем изменяем
    for (sort keys %$options) {
        if (exists($curr->{$_})) {
            my %hash = (%{$curr->{$_}}, %{$options->{$_}});
            %{$curr->{$_}} = %hash;
        } else {
            $curr->{$_} = $options->{$_};
        }
    }
    return $curr;
}

=items SYNOPSYS

    use MCVS::SVN;

    my $svn = MCVS::SVN->new({
        global => {
            '--username'            =>  'mirkos',
            '--password'            =>  'gfhjkm',
            '--no-auth-cache'       =>   1,
        },
        host => 'file://|http://'
        to   => PATH
    })

=cut

sub new {
    my ($class, $options) = @_;
    my $self = {
        vcs     => 'svn',
        global  => {
            '--no-auth-cache'     => 0,
            '--non-interactive'   => 0,
            '--trust-server-cert' => 0,
        },
        command => {
            add    => { '--force' => "*" },
            commit => { '--message' => "'auto commit'" },
            delete => { '--force' => "*" },
        },
    };

    croak "not decree the host of repositoy"
        unless $options->{host};

    $self = __mode_options($options, $self);
    return bless $self, $class;
}

sub AUTOLOAD {
    my ($self) = @_;
    my $program = our $AUTOLOAD;
    $program =~ s/.*:://;
    $self->{current} = $program;
    die "$program command not found 'svn help'" unless (grep { $_ eq $program} @comand);

    {
        no strict 'refs';
        *{$AUTOLOAD} = sub {
            my ($self, $valid) = @_;
            my (@list_arrg);
            if (ref $self eq __PACKAGE__) {
                if ($valid) {
                    %{$self->{command}->{$self->{current}}} = %{$valid};
                }
                @list_arrg = ($self->_cmd_arrg);
            }
            return $self->_execute(@list_arrg);
        }
    }
    goto &$AUTOLOAD;
}

sub _cmd_arrg {
    my ($self) = shift;
    my @result;

    if (($self->{host}) and ($self->{current} eq 'checkout')) {
        push @result, $self->{host};
        push @result, $self->{NameRepository} if ($self->{NameRepository});
    }
    if  (exists $self->{command}->{$self->{current}}) {
        push @result, $self->_parsing_options($self->{command}->{$self->{current}});
    }
    push @result, $self->_parsing_options($self->{global});

    return @result;
}

sub _parsing_options;

sub _parsing_options {
    my ($self)  = shift;
    my $attr    = shift;
    my @result  = ();
    my ($_key, $_value);

    while (($_key, $_value) = each %$attr) {
        if (ref $_value eq 'HASH') {
            push @result, $self->_parsing_options($_value);
        } else {
            if ($_value eq '1') {
                push @result, $_key
            } elsif ($_value =~ m/[^01]/) {
                push @result, $_key, $_value;
            }
        }
    }
    return @result;
}

sub _workdir {
    my $self = shift;
    my $CWD = $self->{local};

    if ($self->{current} eq 'checkout') {
        if (defined $CWD) {
            mkdir $CWD if (!-d $CWD);
            chdir $CWD;
        } else {
            chdir Cwd->getcwd();
        }
    } else {
        chdir "$CWD/$self->{NameRepository}";
    }

}

sub __prepare_arrg {
    my $self = shift;
    my @options = @_;
    my $cmd_str = join ' ', @options;

    {   # todo: delete printf
        printf "debug: ";
        printf "%s %s %s\n\n\n", $self->{vcs}, $self->{current}, $cmd_str;
    }

    return sprintf "%s %s %s\n", $self->{vcs}, $self->{current}, $cmd_str;
}

sub _execute {
    my ($self)  = shift;
    my @options = @_;

    $self->_workdir;
    (system($self->__prepare_arrg(@options)) == 0)
        or croak sprintf "Run-time error: %s", $self->{current};
}

sub DESTROY {}

TRUE;
\$\endgroup\$
  • \$\begingroup\$ This code looks fine. I am not using svn ( but I use git frequently) so I have not tried to run your code. Some comments: mkdir and chdir can fail. You do not check for failures. system command returns details about the failure if it fails. It can fail for many reasons, not only command failure. For example interrupted by CTRL-C. You could add signal handlers to catch interrupts and provide recovery oportunities if interrupted in the middle of an operation, or prevent certain interrupts from occuring when doing sensitive operations. \$\endgroup\$ – Håkon Hægland Mar 26 '17 at 12:35
  • \$\begingroup\$ Your POD is weird. It is usually be =head1 SYNOPSIS. \$\endgroup\$ – simbabque Mar 27 '17 at 15:14
  • 1
    \$\begingroup\$ @HåkonHægland, Thank you for your comment! I changed my code, the new version can be found here (github.com/mirkos-vf/vcs/tree/dev) \$\endgroup\$ – Влад Миркос Apr 12 '17 at 13:06

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.