--- 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