mc/vfs/extfs/patchfs.in

#! @PERL@ -w
#
# Written by Adam Byrtek <alpha@debian.org>, 2002
# 
# extfs to handle patches in unified diff format

use bytes;
use strict;
use POSIX;

# standard binaries
my $bzcat = "bzip2 -dc";
my $gzcat = "zcat";
my $file = "file";

# date parsing requires Date::Parse from TimeDate module
my $parsedates = eval "require Date::Parse";

sub timef
{
    # format unix time
    my @time=localtime($_[0]);
    return sprintf "%02d-%02d-%d %02d:%02d", $time[4]+1, $time[3],
		   $time[5] + 1900, $time[2], $time[1];
}

sub datetime
{
    # in case of problems fall back to 0 in unix time
    # note: str2time interprets some wrong values (eg. " ") as 'today'
    if ($parsedates && defined (my $t=str2time($_[0]))) {
	return timef($t);
    }
    return timef(time);
}

sub list
{
    my ($f,$d,$state,$pos,$npos);
    my ($uid,$gid)=(`id -nu` || "0",`id -ng` || "0");
    chomp ($uid, $gid);

    import Date::Parse if ($parsedates);
    
    # state==1 means diff contents, state==0 mens comments
    $state=1;
    $f="";
    while (<I>) {
	if (/^--- /) {
	    # start of a new file
	    if ($state==1) {
		$npos=tell(I)-length;
		printf "-rw-r--r-- 1 %s %s %d %s %s\n", $uid, $gid, $npos-$pos, datetime($d), $f
		  if $f;
		$pos=$npos;
	    }
	    $state=1;
	    s/^--- ([^\s]+).*$/$1/;
	    chomp;
	    $f=$_;
	    $d="";
	} elsif (/^\+\+\+ /) {
	    # take date from the +++ field
	    s/^\+\+\+ ([^\s]+)\s*//;
	    s/^([^\t]+).*$/$1/;
	    chomp;
	    $d=$_;
	} elsif ($state==1 && !/^([+\- ]|@@)/) {
	    # start of comments, end of diff contents
	    $npos=tell(I)-length;
	    printf "-rw-r--r-- 1 %s %s %d %s %s\n", $uid, $gid, $npos-$pos, datetime($d), $f
	      if $f;
	    $pos=$npos;
	    $state=0;
	}
    }
    $npos=tell(I);
    printf "-rw-r--r-- 1 %s %s %d %s %s\n", $uid, $gid, $npos-$pos, datetime($d), $f
      if $f && $state!=0;

    close I;
}

sub copyout
{
    my ($file,$out)=@_;
    my ($f,$state,$pos);

    open O, "> $out";
    $state=1;
    $f="";
    while (<I>) {
	if (/^--- /) {
	    # start of a new file
	    if ($state==1) {
		if ($f eq $file) {
		    seek(I,-length,1);
		    last;
		}
		$pos=tell(I)-length;
	    }
	    $state=1;
	    s/^--- ([^\s]+).*$/$1/;
	    chomp;
	    $f=$_;
	} elsif ($state==1 && !/^([+\- ]|@@)/) {
	    # start of comments, end of diff contents
	    if ($f eq $file) {
		seek(I,-length,1);
		last;
	    }
	    $pos=tell(I)-length;
	    $state=0;
	}
    }
    if ($f eq $file) {
	my $here=tell(I);
	seek(I,$pos,0);
	read(I,my $buf,$here-$pos);
	print O $buf;
    }

    close O;
}


my $tmp;
my $quoted_name = quotemeta $ARGV[1];
$_=`$file $quoted_name`;
if (/bzip/) {
    $tmp=tmpnam();
    system "$bzcat $quoted_name > $tmp";
    open I, "< $tmp";
} elsif (/gzip/) {
    $tmp=tmpnam();
    system "$gzcat $quoted_name > $tmp";
    open I, "< $tmp";
} else {
    open I, "< $ARGV[1]";
}

if ($ARGV[0] eq "list") {
    list;
    exit(0);
} if ($ARGV[0] eq "copyout") {
    copyout ($ARGV[2], $ARGV[3]);
    exit(0);
}
exit(1);

END {
    system "rm $tmp" if ($tmp);
}