--- shiela 2002/12/23 13:19:40 1.15
+++ shiela 2002/12/23 14:51:34 1.16
@@ -26,7 +26,7 @@
## shiela.pl: control program (syntax: Perl)
##
-my $version = '1.0.3';
+my $version = '1.0.4';
require 5.005;
@@ -54,20 +54,20 @@
$|++;
umask(002);
delete $ENV{TZ};
+$ENV{PATH} = "/bin:/usr/bin:/sbin:/usr/sbin";
# Generic program error handler
$SIG{__DIE__} = sub {
my ($text) = @_;
$text =~ s|\s+at\s+.*||s;
- my $name = ($0 =~ m|^.*?([^/]+?)(?:\.[^/.]+)?$|)[0];
- print STDERR $name.":ERROR: $text" . ($! ? " ($!)" : "") . "\n";
+ print STDERR "cvs:shiela::ERROR: ". $text . ($! ? " ($!)" : "") . "\n";
exit(1);
};
# determine run-time and configuration information
my $PA = &pa_determine(@ARGV);
my $RT = &rt_determine_one($0, $version);
-my $CF = &cf_determine(($PA->{OPT}->{config} || $RT->{cvsadmdir}."/$RT->{name}.cfg"));
+my $CF = &cf_determine(($PA->{OPT}->{config} || $RT->{cvsadmdir} . "/$RT->{name}.cfg"));
$RT = &rt_determine_two($RT, $CF);
# DEBUGGING
@@ -98,7 +98,7 @@
$rv = &hook_loginfo($PA, $RT, $CF);
}
else {
- die "unknown hook (use --hook option)";
+ die "unknown processing stage (use --hook option)";
}
exit($rv);
@@ -163,11 +163,16 @@
}
$RT->{usergroups} = join(',', @G);
+ # optionally set environment variables (like PATH)
+ foreach my $var (keys(%{$CF->{Environment}->{Setenv}})) {
+ $ENV{PATH} = $CF->{Environment}->{Setenv}->{$var};
+ }
+
# determine various program paths
sub find_program {
my ($name) = @_;
my ($prog) = '';
- foreach my $dir (split(/:/, "$ENV{PATH}:/bin:/usr/bin:/sbin:/usr/sbin")) {
+ foreach my $dir (split(/:/, $ENV{PATH})) {
if (-x "$dir/$name") {
$prog = "$dir/$name";
last;
@@ -373,7 +378,8 @@
my ($file) = @_;
# read configuration file
- my $io = new IO::File "<$file" || die "unable to open configuration file `$file'";
+ my $io = new IO::File "<$file"
+ || die "unable to open configuration file `$file'";
my $t = '';
$t .= $_ while (<$io>);
$io->close;
@@ -393,7 +399,8 @@
'Report' => {}
},
'Environment' => {
- 'Program' => {}
+ 'Program' => {},
+ 'Setenv' => {}
}
};
my $cf = &parse_config($t, \&parse_config_callback, $CF);
@@ -452,6 +459,9 @@
elsif ($action eq 'CMD' and $cf->[0] eq 'Program') {
$CF->{Environment}->{Program}->{$cf->[1]} = $cf->[2];
}
+ elsif ($action eq 'CMD' and $cf->[0] eq 'Setenv') {
+ $CF->{Environment}->{Setenv}->{$cf->[1]} = $cf->[2];
+ }
return $cf;
}
return $CF;
@@ -849,14 +859,15 @@
foreach my $file (keys(%{$IN->{file}})) {
my $e = $IN->{file}->{$file};
$O .= $IN->{handle};
- $O .= ",$file";
- $O .= ",".$e->{oldrev};
- $O .= ",".$e->{newrev};
- $O .= ",".$e->{branch};
- $O .= ",".$e->{op};
- $O .= ",".$e->{keysub};
- $O .= ",".$e->{date};
- $O .= ",".$e->{delta};
+ $O .= "|".$RT->{userid};
+ $O .= "|".$file;
+ $O .= "|".$e->{oldrev};
+ $O .= "|".$e->{newrev};
+ $O .= "|".$e->{branch};
+ $O .= "|".$e->{op};
+ $O .= "|".$e->{keysub};
+ $O .= "|".$e->{date};
+ $O .= "|".$e->{delta};
$O .= "\n";
}
my $io = new IO::File ">>".$RT->{historydb}
@@ -868,8 +879,8 @@
sub history_load {
my ($PA, $RT, $CF, $handle) = @_;
- # XXX STILL MISSING, BECAUSE NOT USED XXX
- # XXX HAS TO RE-DETERMINE DIFF AND LOG INFORMATION XXX
+ ## STILL MISSING, BECAUSE CURRENTLY NOT USED AT ALL. ##
+ ## WOULD HAVE TO RE-DETERMINE DIFF AND LOG INFORMATION. ##
return;
}
@@ -959,7 +970,7 @@
# make sure CVS: lines do not harm anyone
$msg =~ s/^CVS:.*?$//mg;
- # remove common empty fields
+ # remove common empty fields (FIXME: PERHAPS TOO HARD-CODED)
$msg =~ s/^(PR|Submitted by|Reviewed by|Approved by|Obtained from):\s*$//img;
# remove trailing whitespaces
@@ -1526,7 +1537,7 @@
# if we are using a stock CVS version, we have to determine
# extra information (which an RSE CVS version would provide).
- if ( ( ( defined($cvsinfo[0])
+ if ( ( ( defined($cvsinfo[0])
and $cvsinfo[0] =~ m|^([^,]+),([^,]+),([^,]+)$|)
or not $RT->{cvsrse} )
and not $RT->{cvsop} eq 'import' ) {
@@ -2148,10 +2159,10 @@
my $branch;
foreach $branch (sort(keys(%{$list}))) {
if ($branch eq 'HEAD') {
- $O .= $prefix."$header:\n";
+ $O .= sprintf("%s%s\n", $prefix, "$header:");
}
else {
- $O .= $prefix.sprintf("%-25s %s\n", "$header:", "(Branch: $branch)");
+ $O .= sprintf("%s%-25s %s\n", $prefix, "$header:", "(Branch: $branch)");
}
$O .= &format_branch($prefix, $header, $branch, $list->{$branch});
}
@@ -2173,27 +2184,28 @@
my $first = 1;
my $col = 0;
foreach $file (sort(@{$list})) {
- if ($col+length($file)+1 > 78) {
+ if (($col + 1 + length($file)) > 78) {
$O .= "\n";
$col = 0;
}
if ($col == 0) {
if ($first) {
- if (length($dir) > 25) {
- $O .= $prefix.sprintf("%s\n$prefix%-25s", " $dir", "");
+ if ((2+length($dir)) > 25) {
+ $O .= sprintf("%s%s\n", $prefix, " " . $dir);
+ $O .= sprintf("%s%-25s", $prefix, "");
}
else {
- $O .= $prefix.sprintf("%-25s", " $dir");
+ $O .= sprintf("%s%-25s", $prefix, " " . $dir);
}
$first = 0;
}
else {
- $O .= $prefix.sprintf("%-25s", "");
+ $O .= sprintf("%s%-25s", $prefix, "");
}
- $col += length($prefix)+25;
+ $col += length($prefix) + 25;
}
- $O .= " $file";
- $col += length($file)+1;
+ $O .= " " . $file;
+ $col += 1 + length($file);
}
$O .= "\n" if ($O !~ m|\n$|s);
return $O;
|
