chiark / gitweb /
pure code motion in Topbloke.pm
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 23 Jan 2012 01:26:07 +0000 (01:26 +0000)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Mon, 23 Jan 2012 01:26:07 +0000 (01:26 +0000)
Topbloke.pm

index 215ae6b..66139e1 100644 (file)
@@ -39,6 +39,8 @@ sub debug ($) {
     print STDERR "DEBUG: $msg\n" or die $!;
 }
 
+#----- general interaction with git -----
+
 sub run_git {
     # takes optional prefix arguments:
     #    coderef    hook to call for each line read,
@@ -148,6 +150,8 @@ sub git_dir () {
     return $git_dir;
 }
 
+#----- specific interactions with git -----
+
 sub chdir_toplevel () {
     my $toplevel;
     run_git(sub { $toplevel = $_; }, 
@@ -166,6 +170,71 @@ sub enable_reflog ($) {
     close REFLOG or die $!;
 }    
 
+sub check_no_unwanted_metadata ($) {
+    # for checking foreign branches aren't contaminated
+    my ($gitbranch) = @_;
+    run_git_check_nooutput('foreign unexpectedly contains',
+                          qw(ls-tree --name-only),
+                          "$gitbranch:",
+                          qw(.topbloke));
+}
+
+#----- configuring a tree -----
+
+sub setup_config () {
+    my (@files) = (qw(msg deps included flags pflags));
+    my $version = 1;
+    foreach my $iteration (qw(0 1)) {
+       foreach my $file (@files) {
+           my $cfgname = "merge.topbloke-$file";
+           my ($current, $current_estatus);
+           run_git(\$current_estatus,
+                   sub { $current = $_; },
+                   qw(config), "$cfgname.driver");
+           $current = "## failed $current_estatus" if $current_estatus;
+           next if $current =~ m/^topbloke-merge-driver --v$version /o;
+           die "$file $current ?" if $iteration;
+           debug("setting merge driver $file");
+           run_git(qw(config), "$cfgname.name",
+                   "topbloke merge driver for $file");
+           run_git(qw(config), "$cfgname.driver",
+                   "topbloke-merge-driver --v$version".
+                   " $file %O %A %B %L");
+       }
+       my ($newattrs, $attrsfile);
+       foreach my $file (@files) {
+           my $path = ".topbloke/$file";
+           my $current = run_git_1line(qw(check-attr merge), $path);
+           $current =~ s#^\Q$path\E: merge: ## or die "$file $current ?";
+           my $want = "topbloke-$file";
+           next if $current eq $want;
+           die "$file $current ?" unless $current eq 'unspecified';
+           die "$file $current ?" if $iteration;
+           if (!$newattrs) {
+               $attrsfile = git_dir()."/info/attributes";
+               $newattrs = new IO::File "$attrsfile.tmp", 'w'
+                   or die "$attrsfile.tmp: $!";
+               if (!open OA, '<', "$attrsfile") {
+                   die "$attrsfile $!" unless $!==&ENOENT;
+               } else {
+                   while (<OA>) {
+                       print $newattrs $_ or die $!;
+                       print "\n" or die $! unless chomp;
+                   }
+                   die $! if OA->error;
+                   die $! unless close OA;
+               }
+           }
+           print $newattrs "$path\tmerge=$want\n" or die $!;
+       }
+       last if !$newattrs;
+       close $newattrs or die $!;
+       rename "$attrsfile.tmp", "$attrsfile" or die $!;
+    }
+}
+
+#----- branch and patch specs and parsed patch names -----
+
 sub current_branch () {
     open R, git_dir().'/HEAD' or die "open HEAD $!";
     my $ref = <R>;  defined $ref or die $!;
@@ -274,67 +343,6 @@ sub parse_patch_spec ($) {
     return $spec;
 }
 
-sub setup_config () {
-    my (@files) = (qw(msg deps included flags pflags));
-    my $version = 1;
-    foreach my $iteration (qw(0 1)) {
-       foreach my $file (@files) {
-           my $cfgname = "merge.topbloke-$file";
-           my ($current, $current_estatus);
-           run_git(\$current_estatus,
-                   sub { $current = $_; },
-                   qw(config), "$cfgname.driver");
-           $current = "## failed $current_estatus" if $current_estatus;
-           next if $current =~ m/^topbloke-merge-driver --v$version /o;
-           die "$file $current ?" if $iteration;
-           debug("setting merge driver $file");
-           run_git(qw(config), "$cfgname.name",
-                   "topbloke merge driver for $file");
-           run_git(qw(config), "$cfgname.driver",
-                   "topbloke-merge-driver --v$version".
-                   " $file %O %A %B %L");
-       }
-       my ($newattrs, $attrsfile);
-       foreach my $file (@files) {
-           my $path = ".topbloke/$file";
-           my $current = run_git_1line(qw(check-attr merge), $path);
-           $current =~ s#^\Q$path\E: merge: ## or die "$file $current ?";
-           my $want = "topbloke-$file";
-           next if $current eq $want;
-           die "$file $current ?" unless $current eq 'unspecified';
-           die "$file $current ?" if $iteration;
-           if (!$newattrs) {
-               $attrsfile = git_dir()."/info/attributes";
-               $newattrs = new IO::File "$attrsfile.tmp", 'w'
-                   or die "$attrsfile.tmp: $!";
-               if (!open OA, '<', "$attrsfile") {
-                   die "$attrsfile $!" unless $!==&ENOENT;
-               } else {
-                   while (<OA>) {
-                       print $newattrs $_ or die $!;
-                       print "\n" or die $! unless chomp;
-                   }
-                   die $! if OA->error;
-                   die $! unless close OA;
-               }
-           }
-           print $newattrs "$path\tmerge=$want\n" or die $!;
-       }
-       last if !$newattrs;
-       close $newattrs or die $!;
-       rename "$attrsfile.tmp", "$attrsfile" or die $!;
-    }
-}
-
-sub check_no_unwanted_metadata ($) {
-    # for checking foreign branches aren't contaminated
-    my ($gitbranch) = @_;
-    run_git_check_nooutput('foreign unexpectedly contains',
-                          qw(ls-tree --name-only),
-                          "$gitbranch:",
-                          qw(.topbloke));
-}
-
 sub patch_matches_spec ($$) {
     my ($parsedname, $spec) = @_;
     foreach my $k (qw(Email Domain Nick)) {
@@ -349,6 +357,8 @@ sub patch_matches_spec ($$) {
     debug("patch_matches_spec  match"), return 1;
 }
 
+#----- reading topbloke metadata -----
+
 sub foreach_patch ($$$$) {
     my ($spec, $deleted_ok, $want, $body) = @_;
     # runs $body->($patch, $parsedname, \%flags, \%deps, \%pflags, \%included)
@@ -404,6 +414,8 @@ sub foreach_patch ($$$$) {
                qw(refs/topbloke-tips));
 }
 
+#----- updating topbloke metadata -----
+
 sub flagsfile_add_flag ($$) {
     # works on "deps" too
     my ($flagsfile, $flag) = @_;
@@ -420,6 +432,8 @@ sub flagsfile_add_flag ($$) {
     wf_done($wf);
 }
 
+#----- general utilities -----
+
 sub wf_start ($) {
     my ($path) = @_;
     my $fh = new IO::File "$path.tmp", '>' or die "create $path.tmp: $!\n";