From: Ian Jackson Date: Wed, 6 May 2020 22:21:00 +0000 (+0100) Subject: nailing-cargo: style: perl indent 2 X-Git-Tag: nailing-cargo/1.0.0~225 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=commitdiff_plain;h=ea0b5d4124baa358b528f66ba23a2c352ef02832;p=nailing-cargo.git nailing-cargo: style: perl indent 2 Signed-off-by: Ian Jackson --- diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..14fbe4c --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1 @@ +((cperl-mode . ((cperl-indent-level . 2)))) diff --git a/nailing-cargo b/nailing-cargo index 1cda402..8d18912 100755 --- a/nailing-cargo +++ b/nailing-cargo @@ -56,270 +56,270 @@ our $verbose=1; our ($noact,$dump); sub read_or_enoent ($) { - my ($fn) = @_; - if (!open R, '<', $fn) { - return undef if $!==ENOENT; - die "$self: open $fn: $!\n"; - } - local ($/) = undef; - my ($r) = // die "$self: read $fn: $!\n"; - $r; + my ($fn) = @_; + if (!open R, '<', $fn) { + return undef if $!==ENOENT; + die "$self: open $fn: $!\n"; + } + local ($/) = undef; + my ($r) = // die "$self: read $fn: $!\n"; + $r; } sub toml_or_enoent ($$) { - my ($f,$what) = @_; - my $toml = read_or_enoent($f) // return; - my ($v,$e) = from_toml($toml); - die "$self: parse TOML: $what: $f: $e\n" unless defined $v; - die "$e ?" if length $e; - $v; + my ($f,$what) = @_; + my $toml = read_or_enoent($f) // return; + my ($v,$e) = from_toml($toml); + die "$self: parse TOML: $what: $f: $e\n" unless defined $v; + die "$e ?" if length $e; + $v; } sub load1config ($) { - my ($f) = @_; - my $toml = toml_or_enoent($f, "config file"); - push @configs, $toml if defined $toml; + my ($f) = @_; + my $toml = toml_or_enoent($f, "config file"); + push @configs, $toml if defined $toml; } sub loadconfigs () { - my $cfgleaf = ".nailing-cargo-cfg.toml"; - load1config("/etc/nailing-cargo/cfg.toml"); - load1config("$worksphere/$cfgleaf"); - load1config("$ENV{HOME}/$cfgleaf") if defined $ENV{HOME}; + my $cfgleaf = ".nailing-cargo-cfg.toml"; + load1config("/etc/nailing-cargo/cfg.toml"); + load1config("$worksphere/$cfgleaf"); + load1config("$ENV{HOME}/$cfgleaf") if defined $ENV{HOME}; } sub getcfg ($$) { - my ($k, $def) = @_; - foreach my $cfg (@configs) { - my $v = $cfg->{$k}; - return $v if defined $v; - } - return $def; + my ($k, $def) = @_; + foreach my $cfg (@configs) { + my $v = $cfg->{$k}; + return $v if defined $v; + } + return $def; } sub unlink_or_enoent ($) { unlink $_[0] or $!==ENOENT; } sub takelock () { - for (;;) { - open LOCK, ">", $lockfile or die "$self: open/create $lockfile: $!\n"; - flock LOCK, LOCK_EX or die "$self: lock $lockfile: $!\n"; - my @fstat = stat LOCK or die "$self: fstat: $!\n"; - my @stat = stat $lockfile; - if (!@stat) { - next if $! == ENOENT; - die "$self: stat $lockfile: $!\n"; - } - last if "@fstat[0..5]" eq "@stat[0..5]"; + for (;;) { + open LOCK, ">", $lockfile or die "$self: open/create $lockfile: $!\n"; + flock LOCK, LOCK_EX or die "$self: lock $lockfile: $!\n"; + my @fstat = stat LOCK or die "$self: fstat: $!\n"; + my @stat = stat $lockfile; + if (!@stat) { + next if $! == ENOENT; + die "$self: stat $lockfile: $!\n"; } + last if "@fstat[0..5]" eq "@stat[0..5]"; + } } sub unlock () { - unlink $lockfile or die "$self: removing lockfile: $!\n"; + unlink $lockfile or die "$self: removing lockfile: $!\n"; } our $nail; sub readnail () { - my $nailfile = "../Cargo.nail"; - open N, '<', $nailfile or die "$self: open $nailfile: $!\n"; - local ($/) = undef; - my $toml = // die "$self: read $nailfile: $!"; - my $transformed; - if ($toml !~ m{^\s*\[/}m && - $toml !~ m{^[^\n\#]*\=}m && - # old non-toml syntax - $toml =~ s{^[ \t]*([-_0-9a-z]+)[ \t]+(\S+)[ \t]*$}{$1 = \"$2\"}mig) { - $toml =~ s{^}{[packages\]\n}; - my @sd; - $toml =~ s{^[ \t]*\-[ \t]*\=[ \t]*(\"[-_0-9a-z]+\"\n?)$}{ - push @sd, $1; ''; - }mige; - $toml = "subdirs = [\n".(join '', map { "$_\n" } @sd)."]\n".$toml; - $transformed = 1; - } - my $e; - ($nail,$e) = from_toml($toml); - if (!defined $nail) { - if ($transformed) { - $toml =~ s/^/ /mg; - print STDERR "$self: $nailfile transformed into TOML:\n$toml\n"; - } - die "$self: parse $nailfile: $e\n"; + my $nailfile = "../Cargo.nail"; + open N, '<', $nailfile or die "$self: open $nailfile: $!\n"; + local ($/) = undef; + my $toml = // die "$self: read $nailfile: $!"; + my $transformed; + if ($toml !~ m{^\s*\[/}m && + $toml !~ m{^[^\n\#]*\=}m && + # old non-toml syntax + $toml =~ s{^[ \t]*([-_0-9a-z]+)[ \t]+(\S+)[ \t]*$}{$1 = \"$2\"}mig) { + $toml =~ s{^}{[packages\]\n}; + my @sd; + $toml =~ s{^[ \t]*\-[ \t]*\=[ \t]*(\"[-_0-9a-z]+\"\n?)$}{ + push @sd, $1; ''; + }mige; + $toml = "subdirs = [\n".(join '', map { "$_\n" } @sd)."]\n".$toml; + $transformed = 1; + } + my $e; + ($nail,$e) = from_toml($toml); + if (!defined $nail) { + if ($transformed) { + $toml =~ s/^/ /mg; + print STDERR "$self: $nailfile transformed into TOML:\n$toml\n"; } - die "$e ?" if length $e; + die "$self: parse $nailfile: $e\n"; + } + die "$e ?" if length $e; } our %manifests; our %packagemap; sub read_manifest ($) { - my ($subdir) = @_; - my $manifest = "../$subdir/Cargo.toml"; - print STDERR "$self: reading $manifest...\n" if $verbose>=4; - if (defined $manifests{$manifest}) { - print STDERR -"$self: warning: $subdir: specified more than once!\n"; - return undef; - } - foreach my $try ("$manifest.unnailed", "$manifest") { - my $toml = toml_or_enoent($try, "package manifest") // next; - my $p = $toml->{package}{name}; - if (!defined $p) { - print STDERR -"$self: warning: $subdir: missing package.name in $try, ignoring\n"; - next; - } - $manifests{$manifest} = $toml; - return $p; - } + my ($subdir) = @_; + my $manifest = "../$subdir/Cargo.toml"; + print STDERR "$self: reading $manifest...\n" if $verbose>=4; + if (defined $manifests{$manifest}) { + print STDERR + "$self: warning: $subdir: specified more than once!\n"; return undef; + } + foreach my $try ("$manifest.unnailed", "$manifest") { + my $toml = toml_or_enoent($try, "package manifest") // next; + my $p = $toml->{package}{name}; + if (!defined $p) { + print STDERR + "$self: warning: $subdir: missing package.name in $try, ignoring\n"; + next; + } + $manifests{$manifest} = $toml; + return $p; + } + return undef; } sub readorigs () { - foreach my $p (keys %{ $nail->{packages} }) { - my $v = $nail->{packages}{$p}; - my $subdir = ref($v) ? $v->{subdir} : $v; - my $gotpackage = read_manifest($subdir) // ''; - if ($gotpackage ne $p) { - print STDERR + foreach my $p (keys %{ $nail->{packages} }) { + my $v = $nail->{packages}{$p}; + my $subdir = ref($v) ? $v->{subdir} : $v; + my $gotpackage = read_manifest($subdir) // ''; + if ($gotpackage ne $p) { + print STDERR "$self: warning: honouring Cargo.nail packages.$subdir=$p even though $subdir contains package $gotpackage!\n"; - } - die if defined $packagemap{$p}; - $packagemap{$p} = $subdir; } - foreach my $subdir (@{ $nail->{subdirs} }) { - my $gotpackage = read_manifest($subdir); - if (!defined $gotpackage) { - print STDERR + die if defined $packagemap{$p}; + $packagemap{$p} = $subdir; + } + foreach my $subdir (@{ $nail->{subdirs} }) { + my $gotpackage = read_manifest($subdir); + if (!defined $gotpackage) { + print STDERR "$self: warning: ignoring subdir $subdir which has no Cargo.toml\n"; - next; - } - $packagemap{$gotpackage} //= $subdir; + next; } + $packagemap{$gotpackage} //= $subdir; + } } sub calculate () { - foreach my $mf (keys %manifests) { - my $toml = $manifests{$mf}; - foreach my $k (qw(dependencies build-dependencies dev-dependencies)) { - my $deps = $toml->{$k}; - next unless $deps; - foreach my $p (keys %packagemap) { - my $info = $deps->{$p}; - next unless defined $info; - $deps->{$p} = $info = { } unless ref $info; - delete $info->{version}; - $info->{path} = $worksphere.'/'.$packagemap{$p}; - } - } - my $nailing = "$mf.nailing~"; - unlink_or_enoent $nailing or die "$self: remove old $nailing: $!\n"; - open N, '>', $nailing or die "$self: create new $nailing: $!\n"; - print N to_toml($toml) or die "$self: write new $nailing: $!\n"; - close N or die "$self: close new $nailing: $!\n"; + foreach my $mf (keys %manifests) { + my $toml = $manifests{$mf}; + foreach my $k (qw(dependencies build-dependencies dev-dependencies)) { + my $deps = $toml->{$k}; + next unless $deps; + foreach my $p (keys %packagemap) { + my $info = $deps->{$p}; + next unless defined $info; + $deps->{$p} = $info = { } unless ref $info; + delete $info->{version}; + $info->{path} = $worksphere.'/'.$packagemap{$p}; + } } + my $nailing = "$mf.nailing~"; + unlink_or_enoent $nailing or die "$self: remove old $nailing: $!\n"; + open N, '>', $nailing or die "$self: create new $nailing: $!\n"; + print N to_toml($toml) or die "$self: write new $nailing: $!\n"; + close N or die "$self: close new $nailing: $!\n"; + } } our $want_uninstall; END { - if ($want_uninstall) { - local ($?); - foreach my $mf (keys %manifests) { - eval { uninstall1($mf,1); 1; } or warn "$@"; - } + if ($want_uninstall) { + local ($?); + foreach my $mf (keys %manifests) { + eval { uninstall1($mf,1); 1; } or warn "$@"; } + } } sub makebackups () { - foreach my $mf (keys %manifests) { - link "$mf", "$mf.unnailed" or $!==EEXIST - or die "$self: make backup link $mf.unnailed: $!\n"; - } + foreach my $mf (keys %manifests) { + link "$mf", "$mf.unnailed" or $!==EEXIST + or die "$self: make backup link $mf.unnailed: $!\n"; + } } sub nailed ($) { - my ($mf) = @_; - my $nailed = "$mf.nailed~"; $nailed =~ s{/([^/]+)$}{/.$1} or die; - $nailed; + my ($mf) = @_; + my $nailed = "$mf.nailed~"; $nailed =~ s{/([^/]+)$}{/.$1} or die; + $nailed; } sub install () { - foreach my $mf (keys %manifests) { - my $nailing = "$mf.nailing~"; - my $nailed = nailed($mf); - my ($use, $rm); - my $diff; - if (open NN, '<', $nailed) { - $diff = compare($nailing, \*NN); - die "$self: compare $nailing and $nailed: $!" if $diff<0; - } else { - $!==ENOENT or die "$self: check previous $nailed: $!\n"; - $diff = 1; - } - if ($diff) { - $use = $nailing; - $rm = $nailed; - } else { - $use = $nailed; - $rm = $nailing; - } - rename $use, $mf or die "$self: install nailed $use: $!\n"; - unlink_or_enoent $rm or die "$self: remove old $rm: $!\n"; - print STDERR "Nailed $mf\n" if $verbose>=3; + foreach my $mf (keys %manifests) { + my $nailing = "$mf.nailing~"; + my $nailed = nailed($mf); + my ($use, $rm); + my $diff; + if (open NN, '<', $nailed) { + $diff = compare($nailing, \*NN); + die "$self: compare $nailing and $nailed: $!" if $diff<0; + } else { + $!==ENOENT or die "$self: check previous $nailed: $!\n"; + $diff = 1; } + if ($diff) { + $use = $nailing; + $rm = $nailed; + } else { + $use = $nailed; + $rm = $nailing; + } + rename $use, $mf or die "$self: install nailed $use: $!\n"; + unlink_or_enoent $rm or die "$self: remove old $rm: $!\n"; + print STDERR "Nailed $mf\n" if $verbose>=3; + } } sub invoke () { - my $r = system @ARGV; - if (!$r) { - return 0; - } elsif ($r<0) { - print STDERR "$self: could not execute $ARGV[0]: $!\n"; - return 127; - } elsif ($r & 0xff00) { - print STDERR "$self: $ARGV[0] failed (exit status $r)\n"; - return $r >> 8; - } else { - print STDERR "$self: $ARGV[0] died due to signal! (wait status $r)\n"; - return 125; - } + my $r = system @ARGV; + if (!$r) { + return 0; + } elsif ($r<0) { + print STDERR "$self: could not execute $ARGV[0]: $!\n"; + return 127; + } elsif ($r & 0xff00) { + print STDERR "$self: $ARGV[0] failed (exit status $r)\n"; + return $r >> 8; + } else { + print STDERR "$self: $ARGV[0] died due to signal! (wait status $r)\n"; + return 125; + } } sub uninstall1 ($$) { - my ($mf, $enoentok) = @_; - my $unnailed = "$mf.unnailed"; - rename $unnailed, $mf or ($enoentok && $!==ENOENT) - or die "$self: failed to restore: rename $unnailed back to $mf: $!\n"; + my ($mf, $enoentok) = @_; + my $unnailed = "$mf.unnailed"; + rename $unnailed, $mf or ($enoentok && $!==ENOENT) + or die "$self: failed to restore: rename $unnailed back to $mf: $!\n"; } sub uninstall () { - foreach my $mf (keys %manifests) { - my $nailed = nailed($mf); - link $mf, $nailed or die "$self: preserve (link) $mf as $nailed: $!\n"; - uninstall1($mf,0); - } + foreach my $mf (keys %manifests) { + my $nailed = nailed($mf); + link $mf, $nailed or die "$self: preserve (link) $mf as $nailed: $!\n"; + uninstall1($mf,0); + } } while (@ARGV && $ARGV[0] =~ m/^-/) { - $_ = shift @ARGV; - last if m{^--$}; - if (m{^-[^-]}) { - while (m{^-.}) { - if (s{^-v}{-}) { - $verbose++; - } elsif (s{^-q}{-}) { - $verbose=0; - } elsif (s{^-n}{-}) { - $noact++; - } elsif (s{^-D}{-}) { - $dump++; - } else { - die "$self: unknown short option(s) $_\n"; - } - } - } else { - die "$self: unknown long option $_\n"; + $_ = shift @ARGV; + last if m{^--$}; + if (m{^-[^-]}) { + while (m{^-.}) { + if (s{^-v}{-}) { + $verbose++; + } elsif (s{^-q}{-}) { + $verbose=0; + } elsif (s{^-n}{-}) { + $noact++; + } elsif (s{^-D}{-}) { + $dump++; + } else { + die "$self: unknown short option(s) $_\n"; + } } + } else { + die "$self: unknown long option $_\n"; + } } takelock(); @@ -328,10 +328,10 @@ readorigs(); calculate(); if ($dump) { - eval ' - use Data::Dumper; - print STDERR Dumper(\%manifests, \%packagemap); - ' or die $@; + eval ' + use Data::Dumper; + print STDERR Dumper(\%manifests, \%packagemap); + ' or die $@; } exit 0 if $noact; @@ -341,8 +341,8 @@ makebackups(); install(); printf STDERR "$self: Nailed (%d manifests, %d packages)\n", - (scalar %manifests, scalar %packagemap) - if $verbose; + (scalar %manifests, scalar %packagemap) + if $verbose; my $estatus = invoke();