Added HG.pm module for ease use of mercurial/hg from perl
authormobst
Wed, 11 Feb 2009 10:34:18 +0000
changeset 13 d9694ca1b7fc
parent 12 b3edfead728b
child 14 744cb8934861
Added HG.pm module for ease use of mercurial/hg from perl Modification notification should now work. (Please enable in /etc/logbuch/config.pm)
Logbuch/HG.pm
Makefile
config.pm
debian/changelog
debian/control
log.pl
--- /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
--- a/Makefile	Tue Feb 03 11:00:50 2009 +0000
+++ b/Makefile	Wed Feb 11 10:34:18 2009 +0000
@@ -13,6 +13,10 @@
 		|| install -m644 config.pm $(DESTDIR)/$(sysconfdir)/config.pm
 	install -d $(bindir)
 	install -m755 $(bin_SCRIPTS) $(DESTDIR)/$(bindir)/
+
+	install -d $(DESTDIR)/usr/share/perl5/Logbuch
+	install -m644 Logbuch/HG.pm $(DESTDIR)/usr/share/perl5/Logbuch/
+
 	cd $(DESTDIR)/$(bindir) && ln -sf log logbuch
 
 clean:
--- a/config.pm	Tue Feb 03 11:00:50 2009 +0000
+++ b/config.pm	Wed Feb 11 10:34:18 2009 +0000
@@ -1,5 +1,5 @@
 package config;
 @mailto = qw(root@localhost);
-@notify_dirs = qw(/etc);
+#@notify_dirs = qw(/etc);
 
 1;
--- a/debian/changelog	Tue Feb 03 11:00:50 2009 +0000
+++ b/debian/changelog	Wed Feb 11 10:34:18 2009 +0000
@@ -1,3 +1,21 @@
+logbuch (0.26-1) stable; urgency=low
+
+  * new upstream
+
+ -- Marcus Obst <mobst@schlittermann.de>  Mon, 09 Feb 2009 13:43:40 +0100
+
+logbuch (0.25-3) stable; urgency=low
+
+  * commented out @notify_dirs
+ 
+ -- Marcus Obst <mobst@schlittermann.de>  Wed, 04 Feb 2009 09:04:22 +0100
+
+logbuch (0.25-2) stable; urgency=low
+
+  * fix dependcies
+
+ -- Marcus Obst <mobst@schlittermann.de>  Wed, 04 Feb 2009 08:35:28 +0100
+
 logbuch (0.25-1) stable; urgency=low
 
   * fix dependcies
--- a/debian/control	Tue Feb 03 11:00:50 2009 +0000
+++ b/debian/control	Wed Feb 11 10:34:18 2009 +0000
@@ -1,15 +1,14 @@
 Source: logbuch
-Section: unknown
+Section: utils
 Priority: optional
 Maintainer: Heiko Schlittermann <heiko@schlittermann.de>
-Build-Depends: debhelper (>> 3.0.0), libmailtools-perl, libdbi-perl,
- libdbd-mysql-perl, libfile-which-perl
+Build-Depends: debhelper (>> 3.0.0), libmailtools-perl, libdbi-perl, libdbd-mysql-perl, libfile-which-perl
 Standards-Version: 3.5.2
 
 Package: logbuch
 Architecture: all
 Suggests: mercurial
 Depends: ${perl:Depends}, libdbi-perl, libdbd-mysql-perl 
-    libmailtools-perl
+    libmailtools-perl, libfile-which-perl, libclass-accessor-perl
 Description: Logbuch for server maintainance
  A simple script for tracking server changes in a logfile
--- a/log.pl	Tue Feb 03 11:00:50 2009 +0000
+++ b/log.pl	Wed Feb 11 10:34:18 2009 +0000
@@ -20,12 +20,13 @@
 use File::Basename;
 use File::Temp qw(tempfile);
 use File::stat;
-use File::Which;
 use Getopt::Long;
 use Mail::Mailer;
 use DBI;
 use MIME::QuotedPrint;
 
+use Logbuch::HG;
+
 use lib "/etc/logbuch";
 use config;
 
@@ -53,8 +54,8 @@
 my $EDITOR = $ENV{VISUAL} || $ENV{EDITOR} || "vim";
 my $MAGIC = "#--- all changes below are ignored ---#\n";
 
-my $opt_db = 0;
-my $opt_mail = 0;
+my $opt_db = 1;
+my $opt_mail = 1;
 my $opt_message = "";
 my $opt_apt = "";
 my $opt_initdir = "";
@@ -99,22 +100,16 @@
     }
 
     if ($opt_initdir) {
-	print "$ME: Trying to initialize $opt_initdir as mercurial repository.\n";
-	-d $opt_initdir or
-	    die "$ME: directory $opt_initdir does not exist!";
+	my $repo = Logbuch::HG->new( repo => $opt_initdir );
 
-	system("hg status $opt_initdir > /dev/null 2>&1");
-	if (($? >> 8)  == 0) {
+	$repo->is_repository() and
 	    die "$ME: directory already initialized, skipping\n";
-	}
 
-	system("hg init $opt_initdir");
-	if ( ($? >> 8) != 0) {
+	$repo->init() or
 	    die "E: initialization failed\n";
-	} else {
-	    system("cd $opt_initdir && hg addremove && hg commit -m 'initial autocommit'");
-	    print "$ME: initialization done.\n";
-	} 
+	
+	$repo->addremove();
+	$repo->commit("initial check in");
 
 	exit 0;
     }
@@ -125,13 +120,14 @@
 	    -d $dir or next;
 
 	    print "$ME: Checking $dir for modifications\n";
-	    -d "$dir/.hg" or 
-		die "$ME: directory $dir not initialized pleas call: \n",
+
+	    my $repo = Logbuch::HG->new( repo => $dir );
+	    $repo->is_repository() or
+		die "$ME: directory $dir not initialized please call: \n",
 		    "  # $ME --init-dir $dir \n";
 
-	    system("hg addremove $dir");
-
-	    $hg_status_text .= `cd / && hg status $dir`;
+	    $repo->addremove();
+	    $hg_status_text .= $repo->status();
 	}
     }
 
@@ -236,7 +232,8 @@
 	    foreach my $dir (@config::notify_dirs) {
 		-d $dir or next;
 
-		system("cd $dir && hg commit -m 'autocommit by logbuch'");
+		my $repo = Logbuch::HG->new( repo => $dir );
+		$repo->commit();
 	    }
 	}
     }
@@ -274,8 +271,9 @@
 
 sub check_hg_bin()
 {
-    if (not defined which('hg')) {
-	print STDERR << 'EOF';
+    if (not Logbuch::HG::hg_available()) {
+
+	die <<'EOF';
 
 You requested an operation based on hg/mercurial but this tool is 
 not installed!
@@ -284,11 +282,10 @@
 remove lines starting with @notify_dirs, or you could simply install the
 required packages:
 
-    # aptitude install mercurial
+    # aptitude install mercurial rcs
 
 Exiting!
 EOF
-	exit 1;
     }
 }