Added HG.pm module for ease use of mercurial/hg from perl
Modification notification should now work.
(Please enable in /etc/logbuch/config.pm)
--- /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;
}
}