package Apache::PATCH;
# file: Apache/PATCH.pm

use strict;
use vars qw($VERSION @EXPORT @ISA);
use Apache::Constants qw(:common BAD_REQUEST);
use Apache::File ();
use File::Basename 'dirname';

@ISA = qw(Exporter);
@EXPORT = qw(PATCH);
$VERSION = '1.00';

use constant PATCH_TYPE => 'application/diff';
my $PATCH_CMD = "/usr/local/bin/patch";

sub handler {
    my $r = shift;
    return DECLINED unless $r->method eq 'PATCH';
    unless ($r->some_auth_required) {
  	$r->log_reason("Apache::PATCH requires access control");
  	return FORBIDDEN;
    }
    $r->handler("perl-script");
    $r->push_handlers(PerlHandler => \&patch_handler);
    return OK;
}

sub patch_handler {
    my $r = shift;
    
    return BAD_REQUEST
	unless lc($r->header_in("Content-type")) eq PATCH_TYPE;
    
    # get file to patch
    my $filename = $r->filename;
    my $dirname = dirname($filename);
    my $reason;
    do {
 	-e $r->finfo or $reason = "$filename does not exist", last;
 	-w _         or $reason = "$filename is not writable", last;
 	-w $dirname  or $reason = "$filename directory is not writable", last;
    };
    if ($reason) {
  	$r->log_reason($reason);
  	return FORBIDDEN;
    }
    
    # get patch data
    my $patch;
    $r->read($patch, $r->header_in("Content-length"));
    
    # new temporary file to hold output of patch command
    my($tmpname, $patch_out) = Apache::File->tmpfile;
    unless($patch_out) {
  	$r->log_reason("can't create temporary output file: $!");
  	return FORBIDDEN;
    }

    # redirect child processes stdout and stderr to temporary file
    open STDOUT, ">&=" . fileno($patch_out);
    
    # open a pipe to the patch command
    local $ENV{PATH}; #keep -T happy 
    my $patch_in = Apache::File->new("| $PATCH_CMD $filename 2>&1");
    unless ($patch_in) {
  	$r->log_reason("can't open pipe to $PATCH_CMD: $!");
  	return FORBIDDEN;
    }
    # write data to the patch command
    print $patch_in $patch;
    close $patch_in;
    close $patch_out;
    
    $patch_out = Apache::File->new($tmpname);
    
    # send the result to the user
    $r->send_http_header("text/plain");
    $r->send_fd($patch_out);
    close $patch_out;
    
    return OK;
}

# This part is for command-line invocation only.
my $opt_C;

sub PATCH {
    require LWP::UserAgent;
    @Apache::PATCH::ISA = qw(LWP::UserAgent);
    
    my $ua = __PACKAGE__->new;
    my $url;
    my $args = @_ ? \@_ : \@ARGV;
    
    while (my $arg = shift @$args) {
  	$opt_C = shift @$args, next if $arg eq "-C";
  	$url = $arg;
    }
    
    my $req = HTTP::Request->new('PATCH' => $url);
    
    my $patch = join '', <STDIN>;
    $req->content(\$patch);
    $req->header('Content-length' => length $patch);
    $req->header('Content-type'   => PATCH_TYPE);
    my $res = $ua->request($req);
    
    if($res->is_success) {
  	print $res->content;
    }
    else {
  	print $res->as_string;
    }
}

sub get_basic_credentials {
    my($self, $realm, $uri) = @_;
    return split ':', $opt_C, 2;
}

1;
__END__