diff -r 86504771a173 -r 3a18d3cd6ae6 Logbuch/HG.pm --- a/Logbuch/HG.pm Fri Apr 28 09:28:28 2017 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,164 +0,0 @@ -# -# Simple perl interface to hg/mercurial. -# - -package Logbuch::HG; - -use warnings; -use strict; -use Carp; -use File::Which; -use Cwd qw(cwd abs_path chdir); - -use fields qw(repo); -use base qw(Class::Accessor::Fast); - -__PACKAGE__->follow_best_practice; -__PACKAGE__->mk_accessors (qw(repo)); - -# print output of external commands -# -my $external_output = 1; - -sub new { - my $class = shift; - - my $self = fields::new($class); - my $args = { @_ }; - - croak "no hg/mercurial binaries available" - if not hg_available(); - - croak "you should given an repository path" - if not defined $args->{repo}; - - $self->set_repo($args->{repo}); - - -d $self->get_repo() or croak "repository is no directory"; - - return $self; -} - -=pod - -Check if given path is a repository - -=cut - -sub is_repository($) { - my $self = shift; - - -d $self->get_repo() . "/.hg" or return 0; - - return 1; -} - - -sub init($) { - my $self = shift; - - if ($self->is_repository()) { - carp "you are trying to initilize an already initilized repository, skipping"; - return 1; - } - - return _run($self->get_repo(), "hg init"); -} - -=pod - -Check if hg binaries are available. -Static methode. - -=cut - -sub hg_available() -{ - (not defined which('hg')) and return 0; - return 1; -} - -=pod - -Update working copy of repository. Adds all new files, automatically -removes no more existing files from repository. - -=cut -sub addremove($) -{ - my $self = shift; - - return _run( $self->get_repo(), "hg addremove" ); -} - -=pod - -Commit working copy to repository. - -=cut -sub commit($;$) { - my $self = shift; - my $message = shift || "auto commit message"; - - return _run( $self->get_repo(), "hg commit -m \"$message\""); -} - - -=pod - -Print status text of repository. - -NOTE: path names will be expanted to absoulte paths!!! - -=cut - -sub status($) { - my $self = shift; - - my @result = _run( $self->get_repo(), "hg status"); - - my $path = $self->get_repo() . "/"; - $result[1] =~ s/^([^\s]+)(\s+)(.*)$/${1}${2}${path}${3}/mg; - - return "$result[1]\n" if $result[1]; -} - - -=pod - -Run shell command in modified environment: - - * cwd is changed to $self->repo - * STDOUT and STDERR are caputred - * return exit code - -=cut - -sub _run($$) { - my $to_dir = shift; - my $cmd = shift; - my $cwd = cwd(); - - chdir($to_dir) or croak "cannot change to repository: $!"; - - # redirect stderr to stdout - $cmd .= " 2>&1"; - - my $output = `$cmd`; - chomp $output; - - chdir($cwd) or croak "cannot chdir back from repository: $!"; - - my $ret = ($? >> 8); - - if (wantarray) { - return ($ret, $output); - } - - print "D: $output\n" if ("$output" and $external_output); - return ($ret > 0) ? 0 : 1; -} - -1; - -# vim: sw=4 sts=4 aw