* [PATCH] git-cvsserver.perl: encourage use of English module and qx() operator
@ 2010-04-16 16:32 jari.aalto
2010-04-16 16:40 ` Randal L. Schwartz
2010-04-16 17:24 ` [PATCH v2] " jari.aalto
0 siblings, 2 replies; 5+ messages in thread
From: jari.aalto @ 2010-04-16 16:32 UTC (permalink / raw)
To: git; +Cc: Jari Aalto
From: Jari Aalto <jari.aalto@cante.net>
Substitute magic variables $<puctuation> with the English.pm
equivalents for readability. Likewise substitute backtics with the
alternative qx() for system calls.
Signed-off-by: Jari Aalto <jari.aalto@cante.net>
---
git-cvsserver.perl | 151 ++++++++++++++++++++++++++--------------------------
1 files changed, 76 insertions(+), 75 deletions(-)
diff --git a/git-cvsserver.perl b/git-cvsserver.perl
index 13751db..0efe8bc 100755
--- a/git-cvsserver.perl
+++ b/git-cvsserver.perl
@@ -19,6 +19,7 @@ use strict;
use warnings;
use bytes;
+use English qw( -no_match_vars );
use Fcntl;
use File::Temp qw/tempdir tempfile/;
use File::Path qw/rmtree/;
@@ -46,7 +47,7 @@ my $DATE_LIST = {
};
# Enable autoflush for STDOUT (otherwise the whole thing falls apart)
-$| = 1;
+$OUTPUT_AUTOFLUSH = 1;
#### Definition and mappings of functions ####
@@ -214,8 +215,8 @@ while (<STDIN>)
# we're fairly screwed because we don't know if the client is expecting
# a response. If it is, the client will hang, we'll hang, and the whole
# thing will be custard.
- $log->fatal("Don't understand command $_\n");
- die("Unknown command $_");
+ $log->fatal("Don't understand command $ARG\n");
+ die("Unknown command $ARG");
}
}
@@ -305,8 +306,8 @@ sub req_Root
return 0;
}
- my @gitvars = `git config -l`;
- if ($?) {
+ my @gitvars = qx( git config -l );
+ if ($CHILD_ERROR) {
print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
print "E \n";
print "error 1 - problem executing git-config\n";
@@ -538,19 +539,19 @@ sub req_add
unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
{
- print "E cvs add: nothing known about `$filename'\n";
+ print "E cvs add: nothing known about '$filename'\n";
next;
}
# TODO : check we're not squashing an already existing file
if ( defined ( $state->{entries}{$filename}{revision} ) )
{
- print "E cvs add: `$filename' has already been entered\n";
+ print "E cvs add: '$filename' has already been entered\n";
next;
}
my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
- print "E cvs add: scheduling file `$filename' for addition\n";
+ print "E cvs add: scheduling file '$filename' for addition\n";
print "Checked-in $dirpart\n";
print "$filename\n";
@@ -579,11 +580,11 @@ sub req_add
if ( $addcount == 1 )
{
- print "E cvs add: use `cvs commit' to add this file permanently\n";
+ print "E cvs add: use 'cvs commit' to add this file permanently\n";
}
elsif ( $addcount > 1 )
{
- print "E cvs add: use `cvs commit' to add these files permanently\n";
+ print "E cvs add: use 'cvs commit' to add these files permanently\n";
}
print "ok\n";
@@ -620,7 +621,7 @@ sub req_remove
if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
{
- print "E cvs remove: file `$filename' still in working directory\n";
+ print "E cvs remove: file '$filename' still in working directory\n";
next;
}
@@ -629,27 +630,27 @@ sub req_remove
unless ( defined ( $wrev ) )
{
- print "E cvs remove: nothing known about `$filename'\n";
+ print "E cvs remove: nothing known about '$filename'\n";
next;
}
if ( defined($wrev) and $wrev < 0 )
{
- print "E cvs remove: file `$filename' already scheduled for removal\n";
+ print "E cvs remove: file '$filename' already scheduled for removal\n";
next;
}
unless ( $wrev == $meta->{revision} )
{
# TODO : not sure if the format of this message is quite correct.
- print "E cvs remove: Up to date check failed for `$filename'\n";
+ print "E cvs remove: Up to date check failed for '$filename'\n";
next;
}
my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
- print "E cvs remove: scheduling `$filename' for removal\n";
+ print "E cvs remove: scheduling '$filename' for removal\n";
print "Checked-in $dirpart\n";
print "$filename\n";
@@ -661,11 +662,11 @@ sub req_remove
if ( $rmcount == 1 )
{
- print "E cvs remove: use `cvs commit' to remove this file permanently\n";
+ print "E cvs remove: use 'cvs commit' to remove this file permanently\n";
}
elsif ( $rmcount > 1 )
{
- print "E cvs remove: use `cvs commit' to remove these files permanently\n";
+ print "E cvs remove: use 'cvs commit' to remove these files permanently\n";
}
print "ok\n";
@@ -709,7 +710,7 @@ sub req_Modified
}
close $fh
- or (print "E failed to write temporary, $filename: $!\n"), return;
+ or (print "E failed to write temporary, $filename: $ERRNO\n"), return;
# Ensure we have something sensible for the file mode
if ( $mode =~ /u=(\w+)/ )
@@ -722,7 +723,7 @@ sub req_Modified
# Save the file data in $state
$state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
$state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
- $state->{entries}{$state->{directory}.$data}{modified_hash} = `git hash-object $filename`;
+ $state->{entries}{$state->{directory}.$data}{modified_hash} = qx( git hash-object $filename );
$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
#$log->debug("req_Modified : file=$data mode=$mode size=$size");
@@ -824,7 +825,7 @@ sub req_co
# Provide list of modules, if -c was used.
if (exists $state->{opt}{c}) {
- my $showref = `git show-ref --heads`;
+ my $showref = qx( git show-ref --heads );
for my $line (split '\n', $showref) {
if ( $line =~ m% refs/heads/(.*)$% ) {
print "M $1\t$1\n";
@@ -980,11 +981,11 @@ sub req_update
# projects (heads in this case) to checkout.
#
if ($state->{module} eq '') {
- my $showref = `git show-ref --heads`;
+ my $showref = qx( git show-ref --heads );
print "E cvs update: Updating .\n";
for my $line (split '\n', $showref) {
if ( $line =~ m% refs/heads/(.*)$% ) {
- print "E cvs update: New directory `$1'\n";
+ print "E cvs update: New directory '$1'\n";
}
}
print "ok\n";
@@ -1101,7 +1102,7 @@ sub req_update
$log->info("Removing '$filename' from working copy (no longer in the repo)");
- print "E cvs update: `$filename' is no longer in the repository\n";
+ print "E cvs update: '$filename' is no longer in the repository\n";
# Don't want to actually _DO_ the update if -n specified
unless ( $state->{globaloptions}{-n} ) {
print "Removed $dirpart\n";
@@ -1249,7 +1250,7 @@ sub req_update
# transmit file, format is single integer on a line by itself (file
# size) followed by the file contents
# TODO : we should copy files in blocks
- my $data = `cat $mergedFile`;
+ my $data = qx( cat $mergedFile );
$log->debug("File size : " . length($data));
print length($data) . "\n";
print $data;
@@ -1291,7 +1292,7 @@ sub req_ci
$updater->update();
# Remember where the head was at the beginning.
- my $parenthash = `git show-ref -s refs/heads/$state->{module}`;
+ my $parenthash = qx( git show-ref -s refs/heads/$state->{module} );
chomp $parenthash;
if ($parenthash !~ /^[0-9a-f]{40}$/) {
print "error 1 pserver cannot find the current HEAD of module";
@@ -1303,7 +1304,7 @@ sub req_ci
$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
- $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
+ $log->info("Created index '$work->{index}' for head $state->{module} - exit status $CHILD_ERROR");
my @committedfiles = ();
my %oldmeta;
@@ -1326,8 +1327,8 @@ sub req_ci
# do a checkout of the file if it is part of this tree
if ($wrev) {
system('git', 'checkout-index', '-f', '-u', $filename);
- unless ($? == 0) {
- die "Error running git-checkout-index -f -u $filename : $!";
+ unless ($CHILD_ERROR == 0) {
+ die "Error running git-checkout-index -f -u $filename : $ERRNO";
}
}
@@ -1357,7 +1358,7 @@ sub req_ci
# Calculate modes to remove
my $invmode = "";
- foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
+ foreach ( qw (r w x) ) { $invmode .= $ARG unless ( $state->{entries}{$filename}{modified_mode} =~ /$ARG/ ); }
$log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
@@ -1387,7 +1388,7 @@ sub req_ci
return;
}
- my $treehash = `git write-tree`;
+ my $treehash = qx( git write-tree );
chomp $treehash;
$log->debug("Treehash : $treehash, Parenthash : $parenthash");
@@ -1404,7 +1405,7 @@ sub req_ci
}
close $msg_fh;
- my $commithash = `git commit-tree $treehash -p $parenthash < $msg_filename`;
+ my $commithash = qx( git commit-tree $treehash -p $parenthash < $msg_filename );
chomp($commithash);
$log->info("Commit hash : $commithash");
@@ -1441,13 +1442,13 @@ sub req_ci
### Emulate git-receive-pack by running hooks/post-receive
my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
if( -x $hook ) {
- open(my $pipe, "| $hook") || die "can't fork $!";
+ open(my $pipe, "| $hook") || die "can't fork $ERRNO";
local $SIG{PIPE} = sub { die 'pipe broke' };
print $pipe "$parenthash $commithash refs/heads/$state->{module}\n";
- close $pipe || die "bad pipe: $! $?";
+ close $pipe || die "bad pipe: $ERRNO $CHILD_ERROR";
}
$updater->update();
@@ -1723,7 +1724,7 @@ sub req_diff
while ( <$fh> )
{
- print "M $_";
+ print "M $ARG";
}
close $fh;
}
@@ -1858,17 +1859,17 @@ sub req_annotate
# to look up the commithash in sqlite (still good to default to
# the current head as we do now)
system("git", "read-tree", $lastseenin);
- unless ($? == 0)
+ unless ($CHILD_ERROR == 0)
{
- print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
+ print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $ERRNO\n";
return;
}
- $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
+ $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $CHILD_ERROR");
# do a checkout of the file
system('git', 'checkout-index', '-f', '-u', $filename);
- unless ($? == 0) {
- print "E error running git-checkout-index -f -u $filename : $!\n";
+ unless ($CHILD_ERROR == 0) {
+ print "E error running git-checkout-index -f -u $filename : $ERRNO\n";
return;
}
@@ -1881,7 +1882,7 @@ sub req_annotate
my $a_hints = "$work->{workDir}/.annotate_hints";
if (!open(ANNOTATEHINTS, '>', $a_hints)) {
- print "E failed to open '$a_hints' for writing: $!\n";
+ print "E failed to open '$a_hints' for writing: $ERRNO\n";
return;
}
for (my $i=0; $i < @$revisions; $i++)
@@ -1895,11 +1896,11 @@ sub req_annotate
print ANNOTATEHINTS "\n";
close ANNOTATEHINTS
- or (print "E failed to write $a_hints: $!\n"), return;
+ or (print "E failed to write $a_hints: $ERRNO\n"), return;
my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
if (!open(ANNOTATE, "-|", @cmd)) {
- print "E error invoking ". join(' ',@cmd) .": $!\n";
+ print "E error invoking ". join(' ',@cmd) .": $ERRNO\n";
return;
}
my $metadata = {};
@@ -1924,7 +1925,7 @@ sub req_annotate
$data
);
} else {
- $log->warn("Error in annotate output! LINE: $_");
+ $log->warn("Error in annotate output! LINE: $ARG");
print "E Annotate error \n";
next;
}
@@ -2114,12 +2115,12 @@ sub transmitfile
die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
- my $type = `git cat-file -t $filehash`;
+ my $type = qx( git cat-file -t $filehash );
chomp $type;
die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
- my $size = `git cat-file -s $filehash`;
+ my $size = qx( git cat-file -s $filehash );
chomp $size;
$log->debug("transmitfile($filehash) size=$size, type=$type");
@@ -2129,22 +2130,22 @@ sub transmitfile
if ( defined ( $options->{targetfile} ) )
{
my $targetfile = $options->{targetfile};
- open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
- print NEWFILE $_ while ( <$fh> );
- close NEWFILE or die("Failed to write '$targetfile': $!");
+ open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $ERRNO");
+ print NEWFILE $ARG while ( <$fh> );
+ close NEWFILE or die("Failed to write '$targetfile': $ERRNO");
} elsif ( defined ( $options->{print} ) && $options->{print} ) {
while ( <$fh> ) {
if( /\n\z/ ) {
- print 'M ', $_;
+ print 'M ', $ARG;
} else {
- print 'MT text ', $_, "\n";
+ print 'MT text ', $ARG, "\n";
}
}
} else {
print "$size\n";
print while ( <$fh> );
}
- close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
+ close $fh or die ("Couldn't close filehandle for transmitfile(): $ERRNO");
} else {
die("Couldn't execute git-cat-file");
}
@@ -2238,10 +2239,10 @@ sub setupWorkTree
if($ver)
{
system("git","read-tree",$ver);
- unless ($? == 0)
+ unless ($CHILD_ERROR == 0)
{
$log->warn("Error running git-read-tree");
- die "Error running git-read-tree $ver in $work->{workDir} $!\n";
+ die "Error running git-read-tree $ver in $work->{workDir} $ERRNO\n";
}
}
# else # req_annotate reads tree for each file
@@ -2272,7 +2273,7 @@ sub ensureWorkTree
chdir $work->{emptyDir} or
die "Unable to chdir to $work->{emptyDir}\n";
- my $ver = `git show-ref -s refs/heads/$state->{module}`;
+ my $ver = qx( git show-ref -s refs/heads/$state->{module} );
chomp $ver;
if ($ver !~ /^[0-9a-f]{40}$/)
{
@@ -2292,9 +2293,9 @@ sub ensureWorkTree
$work->{state} = 1;
system("git","read-tree",$ver);
- unless ($? == 0)
+ unless ($CHILD_ERROR == 0)
{
- die "Error running git-read-tree $ver $!\n";
+ die "Error running git-read-tree $ver $ERRNO\n";
}
}
@@ -2530,8 +2531,8 @@ sub open_blob_or_die
{
if( !open $fh,"<",$name )
{
- $log->warn("Unable to open file $name: $!");
- die "Unable to open file $name: $!\n";
+ $log->warn("Unable to open file $name: $ERRNO");
+ die "Unable to open file $name: $ERRNO\n";
}
}
elsif( $srcType eq "sha1" || $srcType eq "sha1Or-k" )
@@ -2542,7 +2543,7 @@ sub open_blob_or_die
die "Need filehash\n";
}
- my $type = `git cat-file -t $name`;
+ my $type = qx( git cat-file -t $name );
chomp $type;
unless ( defined ( $type ) and $type eq "blob" )
@@ -2551,7 +2552,7 @@ sub open_blob_or_die
die ( "Invalid type '$type' (expected 'blob')" )
}
- my $size = `git cat-file -s $name`;
+ my $size = qx( git cat-file -s $name );
chomp $size;
$log->debug("open_blob_or_die($name) size=$size, type=$type");
@@ -2634,7 +2635,7 @@ sub new
if ( defined ( $filename ) )
{
- open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
+ open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $ERRNO");
}
return $self;
@@ -2654,7 +2655,7 @@ sub setfile
if ( defined ( $filename ) )
{
- open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
+ open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $ERRNO");
}
return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
@@ -2940,10 +2941,10 @@ sub update
# first lets get the commit list
$ENV{GIT_DIR} = $self->{git_path};
- my $commitsha1 = `git rev-parse $self->{module}`;
+ my $commitsha1 = qx( git rev-parse $self->{module} );
chomp $commitsha1;
- my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
+ my $commitinfo = qx( git cat-file commit $self->{module} 2>&1 );
unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
{
die("Invalid module '$self->{module}'");
@@ -2971,7 +2972,7 @@ sub update
push @git_log_params, $self->{module};
}
# git-rev-list is the backend / plumbing version of git-log
- open(GITLOG, '-|', 'git', 'rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
+ open(GITLOG, '-|', 'git', 'rev-list', @git_log_params) or die "Cannot call git-rev-list: $ERRNO";
my @commits;
@@ -3004,7 +3005,7 @@ sub update
next;
}
s/^\s+//; s/\s+$//; # trim ws
- $commit{message} .= $_ . "\n";
+ $commit{message} .= $ARG . "\n";
}
}
close GITLOG;
@@ -3063,14 +3064,14 @@ sub update
# The two branches may not be related at all,
# in which case merge base simply fails to find
# any, but that's Ok.
- next if ($@);
+ next if ($EVAL_ERROR);
chomp $base;
if ($base) {
my @merged;
# print "want to log between $base $parent \n";
open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
- or die "Cannot call git-log: $!";
+ or die "Cannot call git-log: $ERRNO";
my $mergedhash;
while (<GITLOG>) {
chomp;
@@ -3111,14 +3112,14 @@ sub update
if ( defined ( $lastpicked ) )
{
- my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
+ my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $ERRNO");
local ($/) = "\0";
while ( <FILELIST> )
{
chomp;
unless ( /^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o )
{
- die("Couldn't process git-diff-tree line : $_");
+ die("Couldn't process git-diff-tree line : $ARG");
}
my ($mode, $hash, $change) = ($1, $2, $3);
my $name = <FILELIST>;
@@ -3185,14 +3186,14 @@ sub update
# this is used to detect files removed from the repo
my $seen_files = {};
- my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
+ my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $ERRNO");
local $/ = "\0";
while ( <FILELIST> )
{
chomp;
unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
{
- die("Couldn't process git-ls-tree line : $_");
+ die("Couldn't process git-ls-tree line : $ARG");
}
my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
@@ -3556,7 +3557,7 @@ sub in_array
=head2 safe_pipe_capture
-an alternative to `command` that allows input to be passed as an array
+an alternative to qx(command) that allows input to be passed as an array
to work around shell problems with weird characters in arguments
=cut
@@ -3566,9 +3567,9 @@ sub safe_pipe_capture {
if (my $pid = open my $child, '-|') {
@output = (<$child>);
- close $child or die join(' ',@_).": $! $?";
+ close $child or die join(' ',@_).": $ERRNO $CHILD_ERROR";
} else {
- exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
+ exec(@_) or die "$ERRNO $CHILD_ERROR"; # exec() can fail the executable can't be found
}
return wantarray ? @output : join('',@output);
}
--
1.7.0
^ permalink raw reply related [flat|nested] 5+ messages in thread
* Re: [PATCH] git-cvsserver.perl: encourage use of English module and qx() operator
2010-04-16 16:32 [PATCH] git-cvsserver.perl: encourage use of English module and qx() operator jari.aalto
@ 2010-04-16 16:40 ` Randal L. Schwartz
2010-04-16 16:48 ` Jari Aalto
2010-04-16 17:24 ` [PATCH v2] " jari.aalto
1 sibling, 1 reply; 5+ messages in thread
From: Randal L. Schwartz @ 2010-04-16 16:40 UTC (permalink / raw)
To: jari.aalto; +Cc: git
>>>>> "jari" == jari aalto <jari.aalto@cante.net> writes:
jari> Substitute magic variables $<puctuation> with the English.pm
Please no.
That might have been good advice in 2005, but it's crazy talk now.
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Smalltalk/Perl/Unix consulting, Technical writing, Comedy, etc. etc.
See http://methodsandmessages.vox.com/ for Smalltalk and Seaside discussion
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH] git-cvsserver.perl: encourage use of English module and qx() operator
2010-04-16 16:40 ` Randal L. Schwartz
@ 2010-04-16 16:48 ` Jari Aalto
2010-04-16 16:55 ` Randal L. Schwartz
0 siblings, 1 reply; 5+ messages in thread
From: Jari Aalto @ 2010-04-16 16:48 UTC (permalink / raw)
To: Randal L. Schwartz; +Cc: git
merlyn@stonehenge.com (Randal L. Schwartz) writes:
>>>>>> "jari" == jari aalto <jari.aalto@cante.net> writes:
>
> jari> Substitute magic variables $<puctuation> with the English.pm
>
> Please no.
>
> That might have been good advice in 2005, but it's crazy talk now.
It would be interesting to know why not. These magic variables are hard
to read and remember without consulting the manual pages.
There doesn't seem to be noticeable performance penalty any more:
$ perl --version | grep v5
This is perl, v5.10.1 (*) built for x86_64-linux-gnu-thread-multi
$ time perl -e 'use English qw( -no_match_vars ); print'
real 0m0.016s
user 0m0.008s
sys 0m0.004s
$ time perl -e 'print 1'
real 0m0.005s
user 0m0.000s
sys 0m0.004s
Jari
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH] git-cvsserver.perl: encourage use of English module and qx() operator
2010-04-16 16:48 ` Jari Aalto
@ 2010-04-16 16:55 ` Randal L. Schwartz
0 siblings, 0 replies; 5+ messages in thread
From: Randal L. Schwartz @ 2010-04-16 16:55 UTC (permalink / raw)
To: Jari Aalto; +Cc: git
>>>>> "Jari" == Jari Aalto <jari.aalto@cante.net> writes:
Jari> It would be interesting to know why not. These magic variables are hard
Jari> to read and remember without consulting the manual pages.
Because it was observed over time that the aliases were *also* hard to
remember without consulting the manpages. :)
So you were merely trading one problem for another, and since far more
code is out there that does *not* use English than does, we agreed that
use English was an interesting but failed experiment.
--
Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<merlyn@stonehenge.com> <URL:http://www.stonehenge.com/merlyn/>
Smalltalk/Perl/Unix consulting, Technical writing, Comedy, etc. etc.
See http://methodsandmessages.vox.com/ for Smalltalk and Seaside discussion
^ permalink raw reply [flat|nested] 5+ messages in thread
* [PATCH v2] git-cvsserver.perl: encourage use of English module and qx() operator
2010-04-16 16:32 [PATCH] git-cvsserver.perl: encourage use of English module and qx() operator jari.aalto
2010-04-16 16:40 ` Randal L. Schwartz
@ 2010-04-16 17:24 ` jari.aalto
1 sibling, 0 replies; 5+ messages in thread
From: jari.aalto @ 2010-04-16 17:24 UTC (permalink / raw)
To: git; +Cc: Jari Aalto
From: Jari Aalto <jari.aalto@cante.net>
Substitute $<punctuation> magic variables with the English.pm
equivalents for readability. Likewise substitute backtics with the
alternative qx() for system calls.
Signed-off-by: Jari Aalto <jari.aalto@cante.net>
---
git-cvsserver.perl | 151 ++++++++++++++++++++++++++--------------------------
1 files changed, 76 insertions(+), 75 deletions(-)
diff --git a/git-cvsserver.perl b/git-cvsserver.perl
index 13751db..9185237 100755
--- a/git-cvsserver.perl
+++ b/git-cvsserver.perl
@@ -19,6 +19,7 @@ use strict;
use warnings;
use bytes;
+use English ; # qw( -no_match_vars );
use Fcntl;
use File::Temp qw/tempdir tempfile/;
use File::Path qw/rmtree/;
@@ -46,7 +47,7 @@ my $DATE_LIST = {
};
# Enable autoflush for STDOUT (otherwise the whole thing falls apart)
-$| = 1;
+$OUTPUT_AUTOFLUSH = 1;
#### Definition and mappings of functions ####
@@ -214,8 +215,8 @@ while (<STDIN>)
# we're fairly screwed because we don't know if the client is expecting
# a response. If it is, the client will hang, we'll hang, and the whole
# thing will be custard.
- $log->fatal("Don't understand command $_\n");
- die("Unknown command $_");
+ $log->fatal("Don't understand command $ARG\n");
+ die("Unknown command $ARG");
}
}
@@ -305,8 +306,8 @@ sub req_Root
return 0;
}
- my @gitvars = `git config -l`;
- if ($?) {
+ my @gitvars = qx( git config -l );
+ if ($CHILD_ERROR) {
print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
print "E \n";
print "error 1 - problem executing git-config\n";
@@ -538,19 +539,19 @@ sub req_add
unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
{
- print "E cvs add: nothing known about `$filename'\n";
+ print "E cvs add: nothing known about '$filename'\n";
next;
}
# TODO : check we're not squashing an already existing file
if ( defined ( $state->{entries}{$filename}{revision} ) )
{
- print "E cvs add: `$filename' has already been entered\n";
+ print "E cvs add: '$filename' has already been entered\n";
next;
}
my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
- print "E cvs add: scheduling file `$filename' for addition\n";
+ print "E cvs add: scheduling file '$filename' for addition\n";
print "Checked-in $dirpart\n";
print "$filename\n";
@@ -579,11 +580,11 @@ sub req_add
if ( $addcount == 1 )
{
- print "E cvs add: use `cvs commit' to add this file permanently\n";
+ print "E cvs add: use 'cvs commit' to add this file permanently\n";
}
elsif ( $addcount > 1 )
{
- print "E cvs add: use `cvs commit' to add these files permanently\n";
+ print "E cvs add: use 'cvs commit' to add these files permanently\n";
}
print "ok\n";
@@ -620,7 +621,7 @@ sub req_remove
if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
{
- print "E cvs remove: file `$filename' still in working directory\n";
+ print "E cvs remove: file '$filename' still in working directory\n";
next;
}
@@ -629,27 +630,27 @@ sub req_remove
unless ( defined ( $wrev ) )
{
- print "E cvs remove: nothing known about `$filename'\n";
+ print "E cvs remove: nothing known about '$filename'\n";
next;
}
if ( defined($wrev) and $wrev < 0 )
{
- print "E cvs remove: file `$filename' already scheduled for removal\n";
+ print "E cvs remove: file '$filename' already scheduled for removal\n";
next;
}
unless ( $wrev == $meta->{revision} )
{
# TODO : not sure if the format of this message is quite correct.
- print "E cvs remove: Up to date check failed for `$filename'\n";
+ print "E cvs remove: Up to date check failed for '$filename'\n";
next;
}
my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
- print "E cvs remove: scheduling `$filename' for removal\n";
+ print "E cvs remove: scheduling '$filename' for removal\n";
print "Checked-in $dirpart\n";
print "$filename\n";
@@ -661,11 +662,11 @@ sub req_remove
if ( $rmcount == 1 )
{
- print "E cvs remove: use `cvs commit' to remove this file permanently\n";
+ print "E cvs remove: use 'cvs commit' to remove this file permanently\n";
}
elsif ( $rmcount > 1 )
{
- print "E cvs remove: use `cvs commit' to remove these files permanently\n";
+ print "E cvs remove: use 'cvs commit' to remove these files permanently\n";
}
print "ok\n";
@@ -709,7 +710,7 @@ sub req_Modified
}
close $fh
- or (print "E failed to write temporary, $filename: $!\n"), return;
+ or (print "E failed to write temporary, $filename: $ERRNO\n"), return;
# Ensure we have something sensible for the file mode
if ( $mode =~ /u=(\w+)/ )
@@ -722,7 +723,7 @@ sub req_Modified
# Save the file data in $state
$state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
$state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
- $state->{entries}{$state->{directory}.$data}{modified_hash} = `git hash-object $filename`;
+ $state->{entries}{$state->{directory}.$data}{modified_hash} = qx( git hash-object $filename );
$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
#$log->debug("req_Modified : file=$data mode=$mode size=$size");
@@ -824,7 +825,7 @@ sub req_co
# Provide list of modules, if -c was used.
if (exists $state->{opt}{c}) {
- my $showref = `git show-ref --heads`;
+ my $showref = qx( git show-ref --heads );
for my $line (split '\n', $showref) {
if ( $line =~ m% refs/heads/(.*)$% ) {
print "M $1\t$1\n";
@@ -980,11 +981,11 @@ sub req_update
# projects (heads in this case) to checkout.
#
if ($state->{module} eq '') {
- my $showref = `git show-ref --heads`;
+ my $showref = qx( git show-ref --heads );
print "E cvs update: Updating .\n";
for my $line (split '\n', $showref) {
if ( $line =~ m% refs/heads/(.*)$% ) {
- print "E cvs update: New directory `$1'\n";
+ print "E cvs update: New directory '$1'\n";
}
}
print "ok\n";
@@ -1101,7 +1102,7 @@ sub req_update
$log->info("Removing '$filename' from working copy (no longer in the repo)");
- print "E cvs update: `$filename' is no longer in the repository\n";
+ print "E cvs update: '$filename' is no longer in the repository\n";
# Don't want to actually _DO_ the update if -n specified
unless ( $state->{globaloptions}{-n} ) {
print "Removed $dirpart\n";
@@ -1249,7 +1250,7 @@ sub req_update
# transmit file, format is single integer on a line by itself (file
# size) followed by the file contents
# TODO : we should copy files in blocks
- my $data = `cat $mergedFile`;
+ my $data = qx( cat $mergedFile );
$log->debug("File size : " . length($data));
print length($data) . "\n";
print $data;
@@ -1291,7 +1292,7 @@ sub req_ci
$updater->update();
# Remember where the head was at the beginning.
- my $parenthash = `git show-ref -s refs/heads/$state->{module}`;
+ my $parenthash = qx( git show-ref -s refs/heads/$state->{module} );
chomp $parenthash;
if ($parenthash !~ /^[0-9a-f]{40}$/) {
print "error 1 pserver cannot find the current HEAD of module";
@@ -1303,7 +1304,7 @@ sub req_ci
$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
- $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
+ $log->info("Created index '$work->{index}' for head $state->{module} - exit status $CHILD_ERROR");
my @committedfiles = ();
my %oldmeta;
@@ -1326,8 +1327,8 @@ sub req_ci
# do a checkout of the file if it is part of this tree
if ($wrev) {
system('git', 'checkout-index', '-f', '-u', $filename);
- unless ($? == 0) {
- die "Error running git-checkout-index -f -u $filename : $!";
+ unless ($CHILD_ERROR == 0) {
+ die "Error running git-checkout-index -f -u $filename : $ERRNO";
}
}
@@ -1357,7 +1358,7 @@ sub req_ci
# Calculate modes to remove
my $invmode = "";
- foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
+ foreach ( qw (r w x) ) { $invmode .= $ARG unless ( $state->{entries}{$filename}{modified_mode} =~ /$ARG/ ); }
$log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
@@ -1387,7 +1388,7 @@ sub req_ci
return;
}
- my $treehash = `git write-tree`;
+ my $treehash = qx( git write-tree );
chomp $treehash;
$log->debug("Treehash : $treehash, Parenthash : $parenthash");
@@ -1404,7 +1405,7 @@ sub req_ci
}
close $msg_fh;
- my $commithash = `git commit-tree $treehash -p $parenthash < $msg_filename`;
+ my $commithash = qx( git commit-tree $treehash -p $parenthash < $msg_filename );
chomp($commithash);
$log->info("Commit hash : $commithash");
@@ -1441,13 +1442,13 @@ sub req_ci
### Emulate git-receive-pack by running hooks/post-receive
my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
if( -x $hook ) {
- open(my $pipe, "| $hook") || die "can't fork $!";
+ open(my $pipe, "| $hook") || die "can't fork $ERRNO";
local $SIG{PIPE} = sub { die 'pipe broke' };
print $pipe "$parenthash $commithash refs/heads/$state->{module}\n";
- close $pipe || die "bad pipe: $! $?";
+ close $pipe || die "bad pipe: $ERRNO $CHILD_ERROR";
}
$updater->update();
@@ -1723,7 +1724,7 @@ sub req_diff
while ( <$fh> )
{
- print "M $_";
+ print "M $ARG";
}
close $fh;
}
@@ -1858,17 +1859,17 @@ sub req_annotate
# to look up the commithash in sqlite (still good to default to
# the current head as we do now)
system("git", "read-tree", $lastseenin);
- unless ($? == 0)
+ unless ($CHILD_ERROR == 0)
{
- print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
+ print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $ERRNO\n";
return;
}
- $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
+ $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $CHILD_ERROR");
# do a checkout of the file
system('git', 'checkout-index', '-f', '-u', $filename);
- unless ($? == 0) {
- print "E error running git-checkout-index -f -u $filename : $!\n";
+ unless ($CHILD_ERROR == 0) {
+ print "E error running git-checkout-index -f -u $filename : $ERRNO\n";
return;
}
@@ -1881,7 +1882,7 @@ sub req_annotate
my $a_hints = "$work->{workDir}/.annotate_hints";
if (!open(ANNOTATEHINTS, '>', $a_hints)) {
- print "E failed to open '$a_hints' for writing: $!\n";
+ print "E failed to open '$a_hints' for writing: $ERRNO\n";
return;
}
for (my $i=0; $i < @$revisions; $i++)
@@ -1895,11 +1896,11 @@ sub req_annotate
print ANNOTATEHINTS "\n";
close ANNOTATEHINTS
- or (print "E failed to write $a_hints: $!\n"), return;
+ or (print "E failed to write $a_hints: $ERRNO\n"), return;
my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
if (!open(ANNOTATE, "-|", @cmd)) {
- print "E error invoking ". join(' ',@cmd) .": $!\n";
+ print "E error invoking ". join(' ',@cmd) .": $ERRNO\n";
return;
}
my $metadata = {};
@@ -1924,7 +1925,7 @@ sub req_annotate
$data
);
} else {
- $log->warn("Error in annotate output! LINE: $_");
+ $log->warn("Error in annotate output! LINE: $ARG");
print "E Annotate error \n";
next;
}
@@ -2114,12 +2115,12 @@ sub transmitfile
die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
- my $type = `git cat-file -t $filehash`;
+ my $type = qx( git cat-file -t $filehash );
chomp $type;
die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
- my $size = `git cat-file -s $filehash`;
+ my $size = qx( git cat-file -s $filehash );
chomp $size;
$log->debug("transmitfile($filehash) size=$size, type=$type");
@@ -2129,22 +2130,22 @@ sub transmitfile
if ( defined ( $options->{targetfile} ) )
{
my $targetfile = $options->{targetfile};
- open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
- print NEWFILE $_ while ( <$fh> );
- close NEWFILE or die("Failed to write '$targetfile': $!");
+ open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $ERRNO");
+ print NEWFILE $ARG while ( <$fh> );
+ close NEWFILE or die("Failed to write '$targetfile': $ERRNO");
} elsif ( defined ( $options->{print} ) && $options->{print} ) {
while ( <$fh> ) {
if( /\n\z/ ) {
- print 'M ', $_;
+ print 'M ', $ARG;
} else {
- print 'MT text ', $_, "\n";
+ print 'MT text ', $ARG, "\n";
}
}
} else {
print "$size\n";
print while ( <$fh> );
}
- close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
+ close $fh or die ("Couldn't close filehandle for transmitfile(): $ERRNO");
} else {
die("Couldn't execute git-cat-file");
}
@@ -2238,10 +2239,10 @@ sub setupWorkTree
if($ver)
{
system("git","read-tree",$ver);
- unless ($? == 0)
+ unless ($CHILD_ERROR == 0)
{
$log->warn("Error running git-read-tree");
- die "Error running git-read-tree $ver in $work->{workDir} $!\n";
+ die "Error running git-read-tree $ver in $work->{workDir} $ERRNO\n";
}
}
# else # req_annotate reads tree for each file
@@ -2272,7 +2273,7 @@ sub ensureWorkTree
chdir $work->{emptyDir} or
die "Unable to chdir to $work->{emptyDir}\n";
- my $ver = `git show-ref -s refs/heads/$state->{module}`;
+ my $ver = qx( git show-ref -s refs/heads/$state->{module} );
chomp $ver;
if ($ver !~ /^[0-9a-f]{40}$/)
{
@@ -2292,9 +2293,9 @@ sub ensureWorkTree
$work->{state} = 1;
system("git","read-tree",$ver);
- unless ($? == 0)
+ unless ($CHILD_ERROR == 0)
{
- die "Error running git-read-tree $ver $!\n";
+ die "Error running git-read-tree $ver $ERRNO\n";
}
}
@@ -2530,8 +2531,8 @@ sub open_blob_or_die
{
if( !open $fh,"<",$name )
{
- $log->warn("Unable to open file $name: $!");
- die "Unable to open file $name: $!\n";
+ $log->warn("Unable to open file $name: $ERRNO");
+ die "Unable to open file $name: $ERRNO\n";
}
}
elsif( $srcType eq "sha1" || $srcType eq "sha1Or-k" )
@@ -2542,7 +2543,7 @@ sub open_blob_or_die
die "Need filehash\n";
}
- my $type = `git cat-file -t $name`;
+ my $type = qx( git cat-file -t $name );
chomp $type;
unless ( defined ( $type ) and $type eq "blob" )
@@ -2551,7 +2552,7 @@ sub open_blob_or_die
die ( "Invalid type '$type' (expected 'blob')" )
}
- my $size = `git cat-file -s $name`;
+ my $size = qx( git cat-file -s $name );
chomp $size;
$log->debug("open_blob_or_die($name) size=$size, type=$type");
@@ -2634,7 +2635,7 @@ sub new
if ( defined ( $filename ) )
{
- open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
+ open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $main::ERRNO");
}
return $self;
@@ -2654,7 +2655,7 @@ sub setfile
if ( defined ( $filename ) )
{
- open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
+ open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $main::ERRNO");
}
return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
@@ -2940,10 +2941,10 @@ sub update
# first lets get the commit list
$ENV{GIT_DIR} = $self->{git_path};
- my $commitsha1 = `git rev-parse $self->{module}`;
+ my $commitsha1 = qx( git rev-parse $self->{module} );
chomp $commitsha1;
- my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
+ my $commitinfo = qx( git cat-file commit $self->{module} 2>&1 );
unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
{
die("Invalid module '$self->{module}'");
@@ -2971,7 +2972,7 @@ sub update
push @git_log_params, $self->{module};
}
# git-rev-list is the backend / plumbing version of git-log
- open(GITLOG, '-|', 'git', 'rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
+ open(GITLOG, '-|', 'git', 'rev-list', @git_log_params) or die "Cannot call git-rev-list: $main::ERRNO";
my @commits;
@@ -3004,7 +3005,7 @@ sub update
next;
}
s/^\s+//; s/\s+$//; # trim ws
- $commit{message} .= $_ . "\n";
+ $commit{message} .= $main::ARG . "\n";
}
}
close GITLOG;
@@ -3063,14 +3064,14 @@ sub update
# The two branches may not be related at all,
# in which case merge base simply fails to find
# any, but that's Ok.
- next if ($@);
+ next if ($main::EVAL_ERROR);
chomp $base;
if ($base) {
my @merged;
# print "want to log between $base $parent \n";
open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
- or die "Cannot call git-log: $!";
+ or die "Cannot call git-log: $main::ERRNO";
my $mergedhash;
while (<GITLOG>) {
chomp;
@@ -3111,14 +3112,14 @@ sub update
if ( defined ( $lastpicked ) )
{
- my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
+ my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $main::ERRNO");
local ($/) = "\0";
while ( <FILELIST> )
{
chomp;
unless ( /^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o )
{
- die("Couldn't process git-diff-tree line : $_");
+ die("Couldn't process git-diff-tree line : $main::ARG");
}
my ($mode, $hash, $change) = ($1, $2, $3);
my $name = <FILELIST>;
@@ -3185,14 +3186,14 @@ sub update
# this is used to detect files removed from the repo
my $seen_files = {};
- my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
+ my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $main::ERRNO");
local $/ = "\0";
while ( <FILELIST> )
{
chomp;
unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
{
- die("Couldn't process git-ls-tree line : $_");
+ die("Couldn't process git-ls-tree line : $main::ARG");
}
my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
@@ -3556,7 +3557,7 @@ sub in_array
=head2 safe_pipe_capture
-an alternative to `command` that allows input to be passed as an array
+an alternative to qx(command) that allows input to be passed as an array
to work around shell problems with weird characters in arguments
=cut
@@ -3566,9 +3567,9 @@ sub safe_pipe_capture {
if (my $pid = open my $child, '-|') {
@output = (<$child>);
- close $child or die join(' ',@_).": $! $?";
+ close $child or die join(' ',@_).": $main::ERRNO $main::CHILD_ERROR";
} else {
- exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
+ exec(@_) or die "$main::ERRNO $main::CHILD_ERROR"; # exec() can fail the executable can't be found
}
return wantarray ? @output : join('',@output);
}
--
1.7.0
^ permalink raw reply related [flat|nested] 5+ messages in thread
end of thread, other threads:[~2010-04-16 18:26 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2010-04-16 16:32 [PATCH] git-cvsserver.perl: encourage use of English module and qx() operator jari.aalto
2010-04-16 16:40 ` Randal L. Schwartz
2010-04-16 16:48 ` Jari Aalto
2010-04-16 16:55 ` Randal L. Schwartz
2010-04-16 17:24 ` [PATCH v2] " jari.aalto
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).