Logbuch/HG.pm
changeset 113 3a18d3cd6ae6
parent 110 86504771a173
--- 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