lpar

   1 #!/usr/bin/env perl
   2
   3 #=======================================================================
   4 # lpar
   5 # File ID: 5915171c-8768-11e0-9a68-00023faf1383
   6 # Add lpar info of current repo to lpar.git/$1.lpar
   7 #
   8 # Character set: UTF-8
   9 # ©opyleft 2011– Øyvind A. Holm <sunny@sunbase.org>
  10 # License: GNU General Public License version 2 or later, see end of
  11 # file for legal stuff.
  12 #=======================================================================
  13
  14 use strict;
  15 use warnings;
  16 use Getopt::Long;
  17 use Cwd qw{ abs_path getcwd };
  18 use File::Path qw{ make_path };
  19
  20 local $| = 1;
  21
  22 our $Debug = 0;
  23
  24 our %Opt = (
  25
  26     'all' => 0,
  27     'debug' => 0,
  28     'help' => 0,
  29     'set' => undef,
  30     'verbose' => 0,
  31     'version' => 0,
  32
  33 );
  34
  35 our $progname = $0;
  36 $progname =~ s/^.*\/(.*?)$/$1/;
  37 our $VERSION = '0.00';
  38 my $MAX_NAME_LENGTH = 245;
  39 my $allowed_str = "Allowed characters: A-Z, a-z, 0-9, '-', '.', '/' and '_'.\n" .
  40                   "Maximum length: $MAX_NAME_LENGTH chars.\n";
  41
  42 Getopt::Long::Configure('bundling');
  43 GetOptions(
  44
  45     'all|a' => \$Opt{'all'},
  46     'debug' => \$Opt{'debug'},
  47     'help|h' => \$Opt{'help'},
  48     'set|s=s' => \$Opt{'set'},
  49     'verbose|v+' => \$Opt{'verbose'},
  50     'version' => \$Opt{'version'},
  51
  52 ) || die("$progname: Option error. Use -h for help.\n");
  53
  54 $Opt{'debug'} && ($Debug = 1);
  55 $Opt{'help'} && usage(0);
  56 if ($Opt{'version'}) {
  57     print_version();
  58     exit(0);
  59 }
  60
  61 if (get_config_value('lpar.skip') eq 'true') {
  62     msg(0, "lpar.skip is 'true', skip lpar in " . getcwd());
  63     exit(0);
  64 }
  65
  66 if (defined($Opt{'set'}) && $Opt{'set'} eq '?') {
  67     printf("%s\n", get_config_value('lpar.name'));
  68     exit(0);
  69 }
  70
  71 $Opt{'all'} || system("lpar -a");
  72
  73 if (defined($Opt{'set'})) {
  74     my $name = $Opt{'set'};
  75     my $prev = get_config_value('lpar.name');
  76     if (length($name)) {
  77         if (valid_repo_name($name)) {
  78             if ($name eq $prev) {
  79                 msg(0, "Value of lpar.name is already '$name', doing nothing");
  80                 exit(1);
  81             } else {
  82                 msg(0, "Changing value of lpar.name from '$prev' to '$name'");
  83                 exec("git", "config", "lpar.name", $name);
  84             }
  85         } else {
  86             die("$progname: Invalid value in -s/--set argument\n$allowed_str");
  87         }
  88     } else {
  89         msg(0, "Deleting lpar.name config variable, previous value was '$prev'");
  90         exec("git", "config", "--unset", "lpar.name");
  91     }
  92 }
  93
  94 my $repo = $Opt{'all'} ? 'all' : get_config_value("lpar.name");
  95 length($repo) || die("$progname: lpar.name not defined\n");
  96 if (!valid_repo_name($repo)) {
  97     die("$progname: lpar.name contains illegal value\n$allowed_str");
  98 }
  99
 100 my $lpar_dir = $Opt{'all'} ? "$ENV{'HOME'}/src/git/all-lpar" : "$ENV{'HOME'}/src/git/lpar";
 101 my $lpar_file = "$lpar_dir/$repo.lpar.new";
 102 -d $lpar_dir || make_path($lpar_dir);
 103
 104 my @shas = scalar(@ARGV) ? @ARGV : ();
 105 lock_file($lpar_file);
 106 if (scalar(@shas)) {
 107     for my $curr (@shas) {
 108         chomp(my $sha1 = `git log -1 --format=%H "$curr" 2>/dev/null`);
 109         length($sha1) || die("$progname: $curr: Invalid ref, must point to a commit\n");
 110         system("git lpar `git branch -a --contains=\"$sha1\" | cut -c3- | grep -v -e '->' -e '(no branch)'` >>$lpar_file");
 111     }
 112 } else {
 113     system("git lpar --all >>$lpar_file");
 114 }
 115 system("git for-each-ref >>$lpar_file");
 116 unlock_file($lpar_file);
 117
 118 sub lock_file {
 119     # {{{
 120     my $file = shift;
 121     my $lockdir = "$file.lock";
 122     my $did_lock = 0;
 123     until (mkdir($lockdir)) {
 124         print(STDERR "$progname: $file: File is locked, waiting for access...\n");
 125         $did_lock = 1;
 126         sleep(1);
 127     }
 128     $did_lock && print(STDERR "$progname: $file: Obtained lock\n");
 129     return;
 130     # }}}
 131 } # lock_file()
 132
 133 sub unlock_file {
 134     # {{{
 135     my $file = shift;
 136     my $lockdir = "$file.lock";
 137     rmdir($lockdir) || warn("$progname: $lockdir: Lockdir unexpectedly disappeared");
 138     return;
 139     # }}}
 140 } # unlock_file()
 141
 142 sub valid_repo_name {
 143     # {{{
 144     my $repo = shift;
 145     my $retval = ($repo =~ /[^\-\.\/0-9A-Z_a-z]/) ? 0 : 1;
 146     (!length($repo) || length($repo) > $MAX_NAME_LENGTH) && ($retval = 0);
 147     return($retval);
 148     # }}}
 149 } # valid_repo_name()
 150
 151 sub get_config_value {
 152     # {{{
 153     my $name = shift;
 154     my $retval = '';
 155     chomp($retval = `git config --get "$name"`);
 156     return($retval);
 157     # }}}
 158 } # get_config_value()
 159
 160 sub print_version {
 161     # Print program version {{{
 162     print("$progname v$VERSION\n");
 163     return;
 164     # }}}
 165 } # print_version()
 166
 167 sub usage {
 168     # Send the help message to stdout {{{
 169     my $Retval = shift;
 170
 171     if ($Opt{'verbose'}) {
 172         print("\n");
 173         print_version();
 174     }
 175     print(<<"END");
 176
 177 Usage: $progname [options] [included_SHA [...]]
 178
 179 Options:
 180
 181   -a, --all
 182     Dump everything into a single file, ~/src/git/all-lpar/all.lpar .
 183   -h, --help
 184     Show this help.
 185   -s X, --set X
 186     Set the lpar.name variable to X in git config.
 187     To delete, specify "". A value of "?" will print the current value.
 188     To avoid shell expansion, prefix the question mark with a backslash
 189     ("\\") or specify it as "-s?" or "--set=?".
 190   -v, --verbose
 191     Increase level of verbosity. Can be repeated.
 192   --version
 193     Print version information.
 194   --debug
 195     Print debugging messages.
 196
 197 If the Git configuration variable lpar.skip is set to 'true' in a
 198 specific repository, the command is ignored. This is useful when dealing
 199 with shallow clones or grafts where parents or root commits are
 200 different from the original repository.
 201
 202 END
 203     exit($Retval);
 204     # }}}
 205 } # usage()
 206
 207 sub msg {
 208     # Print a status message to stderr based on verbosity level {{{
 209     my ($verbose_level, $Txt) = @_;
 210
 211     if ($Opt{'verbose'} >= $verbose_level) {
 212         print(STDERR "$progname: $Txt\n");
 213     }
 214     return;
 215     # }}}
 216 } # msg()
 217
 218 sub D {
 219     # Print a debugging message {{{
 220     $Debug || return;
 221     my @call_info = caller;
 222     chomp(my $Txt = shift);
 223     my $File = $call_info[1];
 224     $File =~ s#\\#/#g;
 225     $File =~ s#^.*/(.*?)$#$1#;
 226     print(STDERR "$File:$call_info[2] $$ $Txt\n");
 227     return('');
 228     # }}}
 229 } # D()
 230
 231 __END__
 232
 233 # Plain Old Documentation (POD) {{{
 234
 235 =pod
 236
 237 =head1 NAME
 238
 239
 240
 241 =head1 SYNOPSIS
 242
 243  [options] [file [files [...]]]
 244
 245 =head1 DESCRIPTION
 246
 247
 248
 249 =head1 OPTIONS
 250
 251 =over 4
 252
 253 =item B<-h>, B<--help>
 254
 255 Print a brief help summary.
 256
 257 =item B<-v>, B<--verbose>
 258
 259 Increase level of verbosity. Can be repeated.
 260
 261 =item B<--version>
 262
 263 Print version information.
 264
 265 =item B<--debug>
 266
 267 Print debugging messages.
 268
 269 =back
 270
 271 =head1 BUGS
 272
 273
 274
 275 =head1 AUTHOR
 276
 277 Made by Øyvind A. Holm S<E<lt>sunny@sunbase.orgE<gt>>.
 278
 279 =head1 COPYRIGHT
 280
 281 Copyleft © Øyvind A. Holm E<lt>sunny@sunbase.orgE<gt>
 282 This is free software; see the file F<COPYING> for legalese stuff.
 283
 284 =head1 LICENCE
 285
 286 This program is free software: you can redistribute it and/or modify it
 287 under the terms of the GNU General Public License as published by the
 288 Free Software Foundation, either version 2 of the License, or (at your
 289 option) any later version.
 290
 291 This program is distributed in the hope that it will be useful, but
 292 WITHOUT ANY WARRANTY; without even the implied warranty of
 293 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 294 See the GNU General Public License for more details.
 295
 296 You should have received a copy of the GNU General Public License along
 297 with this program.
 298 If not, see L<http://www.gnu.org/licenses/>.
 299
 300 =head1 SEE ALSO
 301
 302 =cut
 303
 304 # }}}
 305
 306 # vim: set fenc=UTF-8 ft=perl fdm=marker ts=4 sw=4 sts=4 et fo+=w :