Re: [RFC/PATCH] gitweb: Use list form of 'open "-|"' pipeline

[Frank Lichtenheld <frank@lichtenheld.de>]

On Sat, Mar 08, 2008 at 05:57:20PM +0100, Jakub Narebski wrote:
> diff --git a/gitweb/gitweb.perl b/gitweb/gitweb.perl
> index a5df2fe..ba97a7b 100755
> --- a/gitweb/gitweb.perl
> +++ b/gitweb/gitweb.perl
> @@ -1455,6 +1455,35 @@ sub git_cmd_str {
>  	return join(' ', git_cmd());
>  }
>  
> +# my $fh = output_pipeline(['cmd_1', 'option'], ['cmd_2', 'argument']);
> +# is equivalent to (is the "list form" of) the following
> +# open my $fh, "-|", "cmd_1 option | cmd_2 argument"
> +#
> +# Based on http://www.perlmonks.org/?node_id=246397

It might be worthwile to look into how e.g. IPC::Run does this.

> +sub output_pipeline {
> +	my @commands_list = @_;
> +	exit unless @commands_list;
> +
> +	my $pid = open(my $fh, "-|");
> +	#die "Couldn't fork: $!" unless defined $pid;

Why are all the die's commented out?

> +	if ($pid) { # parent
> +		return $fh;
> +	}
> +
> +	# child
> + COMMAND:
> +	while (my $command = pop @commands_list) {
> +		my $pid = @commands_list ? open(STDIN, "-|") : -1;
> +		#die "Couldn't fork: $!" unless defined $pid;
> +
> +		next COMMAND unless ($pid); # parent
> +		exec @$command;             # child

The "parent" and "child" comments here are wrong, which was really
really confusing...

This should probably be "new child" instead of "parent" and
"old child" instead of "child".

Thw whole concept of processing the array backwards might be shorter,
I personally find it somewhat confusing though.

What happens to all these child processes anyway if one of them fails to
exec?

> +		#die "Couldn't exec \"@$command\": $!";
> +	}
> +}
> +
>  # get HEAD ref of given project as hash
>  sub git_get_head_hash {
>  	my $project = shift;
> @@ -4545,27 +4574,26 @@ sub git_snapshot {
>  		$hash = git_get_head_hash($project);
>  	}
>  
> -	my $git_command = git_cmd_str();
>  	my $name = $project;
> -	$name =~ s,([^/])/*\.git$,$1,;
> +	$name =~ s,([^/])/*\.git$,$1,; # strip '.git' or '/.git'
>  	$name = basename($name);
> -	my $filename = to_utf8($name);
> -	$name =~ s/\047/\047\\\047\047/g;
> -	my $cmd;
> -	$filename .= "-$hash$known_snapshot_formats{$format}{'suffix'}";
> -	$cmd = "$git_command archive " .
> -		"--format=$known_snapshot_formats{$format}{'format'} " .
> -		"--prefix=\'$name\'/ $hash";
> +	$name = to_utf8($name);  # or only for filename, not prefix?
> +	$name .= "-$hash";
> +
> +	my @cmds = ([git_cmd(), "archive",
> +		"--format=$known_snapshot_formats{$format}{'format'}",
> +		"--prefix=$name/", $hash]);
>  	if (exists $known_snapshot_formats{$format}{'compressor'}) {
> -		$cmd .= ' | ' . join ' ', @{$known_snapshot_formats{$format}{'compressor'}};
> +		push @cmds, $known_snapshot_formats{$format}{'compressor'};
>  	}
>  
>  	print $cgi->header(
>  		-type => $known_snapshot_formats{$format}{'type'},
> -		-content_disposition => 'inline; filename="' . "$filename" . '"',
> +		-content_disposition => 'inline; filename="' .
> +			"$filename$known_snapshot_formats{$format}{'suffix'}" . '"',

Huh, that compiles? Where is $filename defined now at all?

>  		-status => '200 OK');
>  
> -	open my $fd, "-|", $cmd
> +	my $fd = output_pipeline(@cmds)
>  		or die_error(undef, "Execute git-archive failed");
>  	binmode STDOUT, ':raw';
>  	print <$fd>;

Gruesse,
-- 
Frank Lichtenheld <frank@lichtenheld.de>
www: http://www.djpig.de/