Re: New patchfs script

[Adam Byrtek 'alpha' <alpha student uci agh edu pl>]

On Mon, Dec 09, 2002 at 12:16:42PM -0500, Pavel Roskin wrote:
> I hope to put your script on CVS today and I'm ready to make fixes myself,
> but I just want to give you are chance to do it right.

Updated version attached. It works in reasonable time, even with
kernel patches. It supports file size and date parsing. All warnings
fixed. I considered some 'run' virtual methods, but decided they are
redundant. 'patch -p1' is quite simple to type in fact... and one can
add it to mc menu if he wants.

I will not send anything for a week I think, I have to get some rest
after a few days hacking mc. So you will have some time to deal with
my earlier patches :)

Regards

ps. When do you plan to release stable mc? Yes, I know, probably 'when
it will be ready', but what are the predictions?

-- 

  _.|._ |_  _.    : Adam Byrtek, alpha@(irc.pl|debian.org)
 (_|||_)| |(_|    : gg 1802819, pgp 0xB25952C0
     |            : jid alpha.jabberpl.org

#! /usr/bin/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-%02d %02d:%02d", $time[4]+1, $time[3], $time[5]%100, $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(0);
}

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;
$_=`$file $ARGV[1]`;
if (/bzip/) {
    $tmp=tmpnam();
    system "$bzcat $ARGV[1] > $tmp";
    open I, "< $tmp";
} elsif (/gzip/) {
    $tmp=tmpnam();
    system "$gzcat $ARGV[1] > $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);
}