Merge old CVS `ian-dotfiles' repo, as a subtree where we can pick bits

[ian-dotfiles.git] / from-cvs / process

diff --git a/from-cvs/process b/from-cvs/process
new file mode 100755 (executable)
index 0000000..1d8e39d
--- /dev/null
+++ b/from-cvs/process
@@ -0,0 +1,200 @@
+#!/usr/bin/perl
+
+use POSIX;
+
+$action=0;
+defined($umask=umask) or die $!;
+$home= $ENV{'HOME'}.'/';
+
+while ($ARGV[0] =~ m/^-/) {
+    $_= shift(@ARGV);
+    last if m/^--$/;
+    while (m/^-./) {
+       if (s/^-y/-/) {
+           $action=1;
+       } elsif (s/^-u([0-7]{3})/-/) {
+           $umask= oct $1;
+       } elsif (s/^-h/-/) {
+           $home= $';
+       } else {
+           die;
+       }
+    }
+}
+die if @ARGV;
+
+stat $home or die $!;
+-d _ or die;
+
+sub read_prep ($) {
+    my ($inputfile) = @_;
+    defined($c= open P, "-|") or die $!;
+    if (!$c) { exec './gpt','config',$inputfile; die $!; }
+}
+sub fin_prep () {
+    close P; die "$?" if $?;
+}
+
+read_prep('perms');
+for (;;) {
+    $!=0; defined($_=<P>) or die $!;
+    chomp; s/^\s+//; s/\s+$//;
+    next if m/^\#/; next unless m/\S/;
+    last if m/^\.$/;
+    if (m/(.*\S)\s+\-\>\s+(\S.*)/) {
+       $linktargs{$1}= $2;
+    } elsif (m/^(.*\S)\s+\-\-$/) {
+       $exclude{$1}= 1;
+    } elsif (m/^(.*\S)\s+(\S+)$/) {
+       ($of,$pe)=($1,$2);
+       $isdir= $of =~ s,/$,,;
+       if ($pe =~ m/^[0-7]+$/) {
+           $pe= oct $&;
+       } elsif ($pe eq '+x') {
+           $pe= 0777&~$umask;
+       } elsif ($pe eq '/') {
+           $pe= 02777&~$umask;
+       } else {
+           die "$pe ?";
+       }
+       ($isdir ? $dirperms{$of} : $fileperms{$of}) = $pe;
+    }
+}
+fin_prep();
+
+sub mkparents ($) {
+    my ($parent) = @_;
+    $parent =~ s,/[^/]+$,, or return;
+    ensuredir($parent);
+}
+
+sub maybe_chmod ($$$) {
+    my ($nowperms,$perms,$obj) = @_;
+    return if $nowperms==$perms;
+    if ($action) {
+       chmod $perms, $home.$obj or die $!;
+    } else {
+       would($obj, sprintf 'chmod %04o -> %04o', $nowperms, $perms);
+    }
+}
+
+sub ensuredir ($) {
+    my ($dir) = @_;
+    mkparents($dir);
+    $perms= exists $dirperms{$dir} ? $dirperms{$dir} : 02777&~$umask;
+    if (stat $home.$dir) {
+       -d _ or die "$dir is not a directory!";
+       $nowperms= (stat _)[2] & 07777;
+       maybe_chmod($nowperms,$perms,$dir);
+    } else {
+       die $! unless $!==&ENOENT;
+       if ($action) {
+           mkdir $home.$dir, $perms or die $!;
+       } else {
+           would($dir, sprintf 'mkdir %04o', $perms);
+       }
+    }
+}
+
+-d 'new' or mkdir 'new', 02700 or die $!;
+
+sub prep_proc ($$) {
+    my ($if,$newf) = @_;
+    my ($c);
+    defined($c= fork) or die $!;
+    if (!$c) {
+       unlink $newf;
+       open STDOUT, "> $newf" or die "$newf $!";
+       exec './gpt','config',$if; die $!;
+    }
+    $!=0; waitpid($c,0)==$c or die $!;
+    $? and die $?;
+}
+
+opendir D, "files" or die $!;
+while ($if=readdir D) {
+    next unless $if =~ m/^[_a-z0-9\\]/;
+    next if $if =~ m/\~$/;
+    $of= $if; 
+    $of =~ s,_,/,g; 
+    $of =~ s,^/,,;
+    $of =~ s,//,_,g;
+    $of =~ s/\\([0-9a-f][0-9a-f]|_|\\)/
+       length $1 eq 1 ? $1 : sprintf '%c', hex $1 
+           /ge;
+
+    next if $exclude{$of};
+
+    mkparents($of);
+    $newf= 'new/'.$if;
+    prep_proc('files/'.$if,$newf);
+
+    $perms= exists $fileperms{$of} ? $fileperms{$of} : 00666&~$umask;
+    chmod $perms, $newf or die $!;
+    
+    if (stat $home.$of) {
+       -f _ or die "$of is not a file!";
+       $nowperms= (stat _)[2] & 07777;
+       if ($nowperms != $perms) {
+           would($of, sprintf 'chmod %04o -> %04o', $nowperms, $perms);
+       }
+       system 'diff','-u',$home.$of,$newf;
+       $?==0 or $?==256 or die $?;
+       $changes++ if $?;
+    } else {
+       die unless $!==&ENOENT;
+       would($of, sprintf 'create %04o', $perms);
+    }
+    if ($action) {
+       rename $newf,$home.$of or die $!;
+    }
+
+    delete $fileperms{$of};
+}
+closedir D or die $!;
+
+die join(', ', keys %fileperms) if %fileperms;
+
+foreach $link (keys %linktargs) {
+    mkparents($link);
+    $targ= $linktargs{$link};
+    if (lstat $home.$link) {
+       -l _ or die "$link is not a link!";
+       defined($rl= readlink $home.$link) or die $!;
+    } else {
+       die unless $!==&ENOENT;
+       $rl= undef;
+    }
+    if ($rl ne $targ) {
+       would($link, "symlink $targ <-");
+       if ($action) {
+           unlink $home.$link if defined $rl;
+           symlink $targ,$home.$link or die $!;
+       }
+    }
+}
+
+foreach $dir (keys %dirperms) {
+    ensuredir($dir);
+}
+
+sub would ($$) {
+    my ($obj,$what) = @_;
+    return if $would_done{$obj}++;
+    print STDOUT "*** $what $obj\n" or die $!;
+    $changes++;
+}
+
+if ($changes) {
+    print STDOUT "=== $changes changes\n" or die $!;
+} else {
+    print STDOUT "=== no changes\n" or die $!;
+}
+
+prep_proc('execute','new/,execute');
+if ($action) {
+    chmod 0700,'new/,execute' or die $!;
+    system 'new/,execute'; $? and die $?;
+}
+
+close STDOUT or die $!;