--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Logbuch/HG.pm	Wed Feb 11 10:34:18 2009 +0000
@@ -0,0 +1,164 @@
+# 
+#  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];
+}
+
+
+=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