pwx/check_tree.pl

   1 #!/usr/bin/perl -w
   2
   3 # ================================================================
   4 # ===        ==> --------     HISTORY      -------- <==        ===
   5 # ================================================================
   6 #
   7 # Version  Date        Maintainer      Changes, Additions, Fixes
   8 # 0.0.1    2017-04-08  sed, PrydeWorX  First basic design
   9 # ... a lot of undocumented and partly lost development ...
  10 # 0.8.0    2018-02-23  sed, PrydeWorX  2nd gen rewritten due to loss of the original thanks to stupidity.
  11 # 0.8.1    2018-03-05  sed, PrydeWorX  Fixed all outstanding issues and optimized rewriting of shell files.
  12 # 0.8.2    2018-03-06  sed, PrydeWorX  Added checks for elogind_*() function call removals.
  13 # 0.8.3    2018-03-08  sed, PrydeWorX  Handle systemd-logind <=> elogind renames. Do not allow moving of
  14 #                                        commented out includes under out elogind block.
  15 # 0.8.4    2018-03-09  sed, PrydeWorX  Added handling of .gperf files.
  16 #
  17 # ========================
  18 # === Little TODO list ===
  19 # ========================
  20 # - Add masking for XML code. It is a nuisance that the XML templates in the
  21 #   python tools and man sources always generate useless patches. Real patches
  22 #   are in danger of getting overlooked.
  23 # - Add handling of the *.sym files.
  24 #
  25 use strict;
  26 use warnings;
  27 use Cwd qw(getcwd abs_path);
  28 use File::Basename;
  29 use File::Find;
  30 use Readonly;
  31
  32 # ================================================================
  33 # ===        ==> ------ Help Text and Version ----- <==        ===
  34 # ================================================================
  35 Readonly my $VERSION     => "0.8.3"; ## Please keep this current!
  36 Readonly my $VERSMIN     => "-" x length($VERSION);
  37 Readonly my $PROGDIR     => dirname($0);
  38 Readonly my $PROGNAME    => basename($0);
  39 Readonly my $WORKDIR     => getcwd();
  40 Readonly my $USAGE_SHORT => "$PROGNAME <--help|[OPTIONS] <path to upstream tree>>";
  41 Readonly my $USAGE_LONG  => qq#
  42 elogind git tree checker V$VERSION
  43 --------------------------$VERSMIN
  44
  45     Check the current tree, from where this program is called, against an
  46     upstream tree for changes, and generate a patchset out of the differences,
  47     that does not interfere with elogind development markings.
  48
  49 Usage :
  50 -------
  51   $USAGE_SHORT
  52
  53   The path to the upstream tree should have the same layout as the place from
  54   where this program is called. It is best to call this program from the
  55   elogind root path and use a systemd upstream root path for comparison.
  56
  57 Options :
  58 ---------
  59     -c|--commit <refid> | Check out <refid> in the upstream tree.
  60     -f|--file   <path>  | Do not search recursively, check only <path>.
  61                         | For the check of multiple files, you can either
  62                         | specify -f multiple times, or concatenate paths
  63                         | with a comma, or mix both methods.
  64     -h|--help           | Print this help text and exit.
  65 #;
  66
  67 # ================================================================
  68 # ===        ==> -------- Global variables -------- <==        ===
  69 # ================================================================
  70
  71 my $file_fmt        = ""; ## Format string built from the longest file name in generate_file_list().
  72 my $have_wanted     = 0;  ## Helper for finding relevant files (see wanted())
  73 my %hWanted         = (); ## Helper hash for finding relevant files (see wanted())
  74 my $in_else_block   = 0;  ## Set to 1 if we switched from mask/unmask to 'else'.
  75 my $in_mask_block   = 0;  ## Set to 1 if we entered an elogind mask block
  76 my $in_insert_block = 0;  ## Set to 1 if we entered an elogind addition block
  77 my $main_result     = 1;  ## Used for parse_args() only, as simple $result is local everywhere.
  78 my @only_here       = (); ## List of files that do not exist in $upstream_path.
  79 my $previous_commit = ""; ## Store current upstream state, so we can revert afterwards.
  80 my $show_help       = 0;
  81 my @source_files    = (); ## Final file list to process, generated in in generate_file_list().
  82 my $upstream_path     = "";
  83 my $wanted_commit   = "";
  84 my @wanted_files    = (); ## User given file list (if any) to limit generate_file_list()
  85
  86 # ================================================================
  87 # ===        ==> ------- MAIN DATA STRUCTURES ------ <==       ===
  88 # ================================================================
  89 my %hFile = (); ## Main data structure to manage a complete compare of two files. (See: build_hFile() )
  90                 ## Note: %hFile is used globaly for each file that is processed.
  91                 ## The structure is:
  92                 ## ( count  : Number of hunks stored
  93                 ##   hunks  : Arrayref with the Hunks, stored in %hHunk instances
  94                 ##   output : Arrayref with the lines of the final patch
  95                 ##   part   : local relative file path
  96                 ##   patch  : PROGDIR/patches/<part>.patch (With / replaced by _ in <part>)
  97                 ##   source : WORKDIR/<part>
  98                 ##   target : UPSTREAM/<part>
  99                 ## )
 100 my $hHunk = {}; ## Secondary data structure to describe one diff hunk.            (See: build_hHunk() )
 101                 ## Note: $hHunk is used globally for each Hunk that is processed and points to the
 102                 ##       current $hFile{hunks}[] instance.
 103                 ## The structure is:
 104                 ## { count      : Number of lines in {lines}
 105                 ##   lines      : list of the lines themselves,
 106                 ##   idx        : Index of this hunk in %hFile{hunks}
 107                 ##   src_start  : line number this hunk starts in the source file.
 108                 ##   tgt_start  : line number this hunk becomes in the target file.
 109                 ##   useful     : 1 if the hunk is transported, 0 if it is to be omitted.
 110                 ## }
 111 my %hIncs  = ();## Hash for remembered includes over different hunks.
 112                 ## Note: Only counted in the first step, actions are only in the second step.
 113                 ## The structure is:
 114                 ## { include => {
 115                 ##     applied : Set to 1 once check_includes() has applied any rules on it.
 116                 ##     elogind = { hunkid : Hunk id ; Position where a "needed by elogin" include is
 117                 ##                 lineid : Line id ; wanted to be removed by the patch.
 118                 ##     }
 119                 ##     insert  = { elogind : Set to 1 if the insert was found under elogind special includes.
 120                 ##                 hunkid  : Hunk id ; Position where a commented out include is
 121                 ##                 lineid  : Line id ; wanted to be removed by the patch.
 122                 ##                 spliceme: Set to 1 if this insert is later to be spliced.
 123                 ##                 sysinc  : Set to 1 if it is <include>, 0 otherwise.
 124                 ##     }
 125                 ##     remove  = { hunkid : Hunk id ; Position where a new include is wanted to be
 126                 ##                 lineid : Line id ; added by the patch.
 127                 ##                 sysinc : Set to 1 if it is <include>, 0 otherwise.
 128                 ##     }
 129                 ## } }
 130 my @lFails = ();## List of failed hunks. These are worth noting down in an extra structure, as these
 131                 ## mean that something is fishy about a file, like elogind mask starts within masks.
 132                 ## The structure is:
 133                 ## ( { hunk : the failed hunk for later printing
 134                 ##     msg  : a message set by the function that failed
 135                 ##     part : local relative file part
 136                 ##   }
 137                 ## )
 138
 139 # ================================================================
 140 # ===        ==> --------  Function list   -------- <==        ===
 141 # ================================================================
 142
 143 sub build_hFile;        ## Inititializes and fills %hFile.
 144 sub build_hHunk;        ## Adds a new $hFile{hunks}[] instance.
 145 sub build_output;       ## Writes $hFile{output} from all useful $hFile{hunks}.
 146 sub check_blanks;       ## Check that useful blank line additions aren't misplaced.
 147 sub check_comments;     ## Check comments we added for elogind specific information.
 148 sub check_debug;        ## Check for debug constructs
 149 sub check_func_removes; ## Check for attempts to remove elogind_*() special function calls.
 150 sub check_includes;     ## performe necessary actions with the help of %hIncs (built by read_includes())
 151 sub check_masks;        ## Check for elogind preprocessor masks
 152 sub check_musl;         ## Check for musl_libc compatibility blocks
 153 sub check_name_reverts; ## Check for attempts to revert 'elogind' to 'systemd'
 154 sub checkout_upstream;  ## Checkout the given refid on $upstream_path
 155 sub clean_hFile;        ## Completely clean up the current %hFile data structure.
 156 sub diff_hFile;         ## Generates the diff and builds $hFile{hunks} if needed.
 157 sub generate_file_list; ## Find all relevant files and store them in @wanted_files
 158 sub get_hunk_head;      ## Generate the "@@ -xx,n +yy,m @@" hunk header line out of $hHunk.
 159 sub hunk_failed;        ## Generates a new @lFails entry and terminates the progress line.
 160 sub hunk_is_useful;     ## Prunes the hunk and checks whether it stil does anything
 161 sub parse_args;         ## Parse ARGV for the options we support
 162 sub prepare_shell;      ## Prepare shell (and meson) files for our processing
 163 sub prune_hunk;         ## remove unneeded prefix and postfix lines.
 164 sub read_includes;      ## map include changes
 165 sub splice_includes;    ## Splice all includes that were marked for splicing
 166 sub unprepare_shell;    ## Unprepare shell (and meson) files after our processing
 167 sub wanted;             ## Callback function for File::Find
 168
 169 # ================================================================
 170 # ===        ==> --------    Prechecks     -------- <==        ==
 171 # ================================================================
 172
 173 $main_result = parse_args(@ARGV);
 174 ( (!$main_result)                 ## Note: Error or --help given, then exit.
 175         or ( $show_help and print "$USAGE_LONG" ) )
 176         and exit(!$main_result);
 177 length($wanted_commit)
 178         and (checkout_upstream($wanted_commit) ## Note: Does nothing if $wanted_commit is already checked out.
 179                 or exit 1);
 180 generate_file_list or exit 1;     ## Note: @wanted_files is heeded.
 181
 182 # ================================================================
 183 # ===        ==> -------- = MAIN PROGRAM = -------- <==        ===
 184 # ================================================================
 185
 186 for my $file_part (@source_files) {
 187         printf("$file_fmt: ", $file_part);
 188
 189         build_hFile($file_part) or next;
 190         diff_hFile or next;
 191
 192         # Reset global state helpers
 193         $in_else_block   = 0;
 194         $in_mask_block   = 0;
 195         $in_insert_block = 0;
 196
 197         # Empty the include manipulation hash
 198         %hIncs = ();
 199
 200         # ---------------------------------------------------------------------
 201         # --- Go through all hunks and check them against our various rules ---
 202         # ---------------------------------------------------------------------
 203         for (my $pos = 0; $pos < $hFile{count}; ++$pos) {
 204                 $hHunk = $hFile{hunks}[$pos]; ## Global shortcut
 205
 206                 # === 1) Check for elogind masks ==================================
 207                 check_masks and hunk_is_useful and prune_hunk or next;
 208
 209                 # === 2) Check for musl_libc compatibility blocks =================
 210                 check_musl and hunk_is_useful and prune_hunk or next;
 211
 212                 # === 3) Check for debug constructs ===============================
 213                 check_debug and hunk_is_useful and prune_hunk or next;
 214
 215                 # === 4) Check for elogind extra comments and information =========
 216                 check_comments and hunk_is_useful and prune_hunk or next;
 217
 218                 # === 5) Check for useful blank line additions ====================
 219                 check_blanks and hunk_is_useful and prune_hunk or next;
 220
 221                 # === 6) Check for 'elogind' => 'systemd' reverts =================
 222                 check_name_reverts and hunk_is_useful and prune_hunk or next;
 223
 224                 # === 7) Check for elogind_*() function removals ==================
 225                 check_func_removes and hunk_is_useful and prune_hunk or next;
 226
 227                 #  ===> IMPORTANT: From here on no more pruning, lines must *NOT* change any more! <===
 228
 229                 # === 8) Analyze includes and note their appearance in $hIncs =====
 230                 read_includes; ## Never fails, doesn't change anything.
 231
 232         } ## End of first hunk loop
 233
 234         # ---------------------------------------------------------------------
 235         # --- Make sure saved include data is sane                          ---
 236         # ---------------------------------------------------------------------
 237         for my $inc (keys %hIncs) {
 238                 $hIncs{$inc}{applied} = 0;
 239                 defined ($hIncs{$inc}{elogind})
 240                         or $hIncs{$inc}{elogind} = {               hunkid => -1, lineid => -1 };
 241                 defined ($hIncs{$inc}{insert})
 242                         or $hIncs{$inc}{insert}  = { elogind => 0, hunkid => -1, lineid => -1, spliceme => 0, sysinc => 0 };
 243                 defined ($hIncs{$inc}{remove})
 244                         or $hIncs{$inc}{remove}  = {               hunkid => -1, lineid => -1,                sysinc => 0 };
 245         }
 246
 247         # ---------------------------------------------------------------------
 248         # --- Go through all hunks and apply remaining changes and checks   ---
 249         # ---------------------------------------------------------------------
 250         for (my $pos = 0; $pos < $hFile{count}; ++$pos) {
 251                 $hHunk = $hFile{hunks}[$pos]; ## Global shortcut
 252
 253                 # (pre -> early out)
 254                 hunk_is_useful or next;
 255
 256                 # === 1) Apply what we learned about changed includes =============
 257                 check_includes and hunk_is_useful or next;
 258
 259         } ## End of second hunk loop
 260
 261         # ---------------------------------------------------------------------
 262         # --- Splice all include insertions that are marked for splicing    ---
 263         # ---------------------------------------------------------------------
 264         splice_includes;
 265
 266         # ---------------------------------------------------------------------
 267         # --- Go through all hunks for a last prune and check               ---
 268         # ---------------------------------------------------------------------
 269         my $have_hunk = 0;
 270         for (my $pos = 0; $pos < $hFile{count}; ++$pos) {
 271                 $hHunk = $hFile{hunks}[$pos]; ## Global shortcut
 272
 273                 # (pre -> early out)
 274                 hunk_is_useful or next;
 275
 276                 prune_hunk and ++$have_hunk;
 277         }
 278
 279         # If we have at least 1 useful hunk, create the output and tell the user what we've got.
 280         $have_hunk
 281                 and build_output # (Always returns 1)
 282                 and printf("%d Hunk%s\n", $have_hunk, $have_hunk > 1 ? "s" : "")
 283                  or print("clean\n");
 284
 285         # Shell and meson files must be unprepared. See unprepare_shell()
 286         $hFile{source} =~ m/\.pwx$/ and unprepare_shell;
 287
 288         # Now skip the writing if there are no hunks
 289         $have_hunk or next;
 290
 291         # That's it, write the file and be done!
 292         if (open(my $fOut, ">", $hFile{patch})) {
 293                 for my $line (@{$hFile{output}}) {
 294                         print $fOut "$line\n";
 295                 }
 296                 close($fOut);
 297         } else {
 298                 printf("ERROR: %s could not be opened for writing!\n%s\n",
 299                         $hFile{patch}, $!);
 300                 die("Please fix this first!");
 301         }
 302 } ## End of main loop
 303
 304 # -------------------------------------------------------------------------
 305 # --- Print out the list of files that only exist here and not upstream ---
 306 # -------------------------------------------------------------------------
 307 if (scalar @only_here) {
 308         my $count = scalar @only_here;
 309         my $fmt   = sprintf("%%d %d: %%s\n", length("$count"));
 310
 311         printf("\n%d file%s only found in $WORKDIR:\n", $count, $count > 1 ? "s": "");
 312
 313         for (my $i = 0; $i < $count; ++$i) {
 314                 printf($fmt, $i + 1, $only_here[$i]);
 315         }
 316 }
 317
 318 # -------------------------------------------------------------------------
 319 # --- Print out the list of failed hunks -> bug in hunk or program?     ---
 320 # -------------------------------------------------------------------------
 321 if (scalar @lFails) {
 322         my $count = scalar @lFails;
 323
 324         printf("\n%d file%s %s have at least one fishy hunk:\n", $count,
 325                $count > 1 ? "s" : "", $count > 1 ? "have" : "has");
 326
 327         for (my $i = 0; $i < $count; ++$i) {
 328                 print "=== $lFails[$i]{part} ===\n";
 329                 print " => $lFails[$i]{msg} <=\n";
 330                 print "---------------------------\n";
 331                 print "$_\n" foreach(@{$lFails[$i]{hunk}});
 332         }
 333 }
 334
 335 # ===========================
 336 # === END OF MAIN PROGRAM ===
 337 # ===========================
 338
 339 # ================================================================
 340 # ===        ==> --------     Cleanup      -------- <==        ===
 341 # ================================================================
 342
 343 length($previous_commit) and checkout_upstream($previous_commit);
 344
 345 # ================================================================
 346 # ===        ==> ---- Function Implementations ---- <==        ===
 347 # ================================================================
 348
 349 # -----------------------------------------------------------------------
 350 # --- Inititializes and fills %hFile. Old values are discarded.       ---
 351 # --- Adds files, that do not exist upstream, to @only_here.          ---
 352 # --- Returns 1 on success, 0 otherwise.                              ---
 353 # -----------------------------------------------------------------------
 354 sub build_hFile {
 355         my ($part) = @_;
 356
 357         defined($part) and length($part) or print("ERROR\n") and die("build_hfile: part is empty ???");
 358
 359         # We only prefixed './' to unify things. Now it is no longer needed:
 360         $part =~ s,^\./,,;
 361
 362         # Pre: erase current $hFile, as that is what is expected.
 363         clean_hFile();
 364
 365         # Check the target file
 366         my $tgt = "$upstream_path/$part";
 367         $tgt =~ s/elogind/systemd/g;
 368         $tgt =~ s/\.pwx$//;
 369         -f $tgt or push(@only_here, $part)
 370                 and print "only here\n"
 371                 and return 0;
 372
 373         # Build the patch name
 374         my $patch = $part;
 375         $patch =~ s/\//_/g;
 376
 377         # Build the central data structure.
 378         %hFile = (
 379                 count  => 0,
 380                 hunks  => [ ],
 381                 output => [ ],
 382                 part   => "$part",
 383                 patch  => "$PROGDIR/patches/${patch}.patch",
 384                 source => "$WORKDIR/$part",
 385                 target => "$tgt"
 386         );
 387
 388         return 1;
 389 }
 390
 391 # -----------------------------------------------------------------------
 392 # --- Build a new $hHunk instance and add it to $hFile{hunks}         ---
 393 # -----------------------------------------------------------------------
 394 sub build_hHunk {
 395         my ($head, @lHunk) = @_;
 396         my $pos = $hFile{count}++;
 397
 398         # The first line must be the hunk positional and size data.
 399         # Example: @@ -136,6 +136,8 @@
 400         # That is @@ -<source line>,<source length> +<target line>,<target length> @@
 401         if ( $head =~ m/^@@ -(\d+),\d+ \+(\d+),\d+ @@/ ) {
 402                 %{$hFile{hunks}[$pos]} = (
 403                         count      => 0,
 404                         idx        => $pos,
 405                         offset     => 0,
 406                         src_start  => $1,
 407                         tgt_start  => $2,
 408                         useful     => 1
 409                 );
 410
 411                 # We need to chomp the lines:
 412                 for my $line (@lHunk) {
 413                         defined($line) or next;
 414                         chomp $line;
 415                         push @{$hFile{hunks}[$pos]{lines}}, $line;
 416                         $hFile{hunks}[$pos]{count}++;
 417                 }
 418                 return 1;
 419         }
 420
 421         print "Illegal hunk no $hFile{count}\n(Head: \"$head\")\n";
 422
 423         return 0;
 424 }
 425
 426 # -----------------------------------------------------------------------
 427 # --- Writes $hFile{output} from all useful $hFile{hunks}.            ---
 428 # --- Important: No more checks, just do it!                          ---
 429 # -----------------------------------------------------------------------
 430 sub build_output {
 431
 432         my $offset = 0; ## Count building up target offsets
 433
 434         for (my $pos = 0; $pos < $hFile{count}; ++$pos) {
 435                 $hHunk = $hFile{hunks}[$pos]; ## Global shortcut
 436                 $hHunk->{useful} or next;     ## And the skip of the useless.
 437
 438                 # --- Add the header line -----------------
 439                 # -----------------------------------------
 440                 push(@{$hFile{output}}, get_hunk_head(\$offset));
 441
 442                 # --- Add the hunk lines ------------------
 443                 # -----------------------------------------
 444                 for my $line (@{$hHunk->{lines}}) {
 445                         push(@{$hFile{output}}, $line);
 446                 }
 447         } ## End of walking the hunks
 448
 449         return 1;
 450 }
 451
 452 # -----------------------------------------------------------------------
 453 # --- Check that useful blank line additions aren't misplaced.        ---
 454 # ---- Note: Sometimes the masks aren't placed correctly, and the diff---
 455 # ----       wants to add a missing blank line. As it tried to remove ---
 456 # ----       our mask first, it'll be added after. That's fine for    ---
 457 # ----       #endif, but not for #if 0.                               ---
 458 # -----------------------------------------------------------------------
 459 sub check_blanks {
 460
 461         # Early exits:
 462         defined($hHunk) or return 0;
 463         $hHunk->{useful} or return 0;
 464
 465         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
 466                 my $line = \$hHunk->{lines}[$i]; ## Shortcut
 467
 468                 if ( ($$line =~ m/^\+\s*$/)
 469                   && ($i > 0)
 470                   && ($hHunk->{lines}[$i-1] =~ m/^[ -+]#if\s+[01].*elogind/) ) {
 471                         # Simply swap the lines
 472                         my $tmp = $$line;
 473                         $$line = $hHunk->{lines}[$i-1];
 474                         $hHunk->{lines}[$i-1] = $tmp;
 475                         next;
 476                 }
 477         }
 478
 479         return 1;
 480 }
 481
 482 # -----------------------------------------------------------------------
 483 # --- Check comments we added for elogind specific information.       ---
 484 # --- These are all comments, and can be both single and multi line.  ---
 485 # -----------------------------------------------------------------------
 486 sub check_comments {
 487
 488         # Early exits:
 489         defined($hHunk) or return 0;
 490         $hHunk->{useful} or return 0;
 491
 492         my $in_comment_block = 0;
 493
 494         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
 495                 my $line = \$hHunk->{lines}[$i]; ## Shortcut
 496
 497                 # Check for comment block start
 498                 # -----------------------------
 499                 if ($$line =~ m,^-\s*(/[*]+|/[/]+).*elogind,) {
 500
 501                         # Sanity check:
 502                         $in_comment_block
 503                                 and return hunk_failed("check_comments: Comment block start found in comment block!");
 504
 505                         substr($$line, 0, 1) = " ";
 506
 507                         # Only start the comment block if this is really a multiline comment
 508                         (!($$line =~ m,\*/[^/]*$,) )
 509                                 and $in_comment_block = 1;
 510
 511                         next;
 512                 }
 513
 514                 # Check for comment block end
 515                 # -----------------------------
 516                 if ($in_comment_block && ($$line =~ m,^-.*\*/\s*$,)) {
 517                         substr($$line, 0, 1) = " ";
 518                         $in_comment_block = 0;
 519                         next;
 520                 }
 521
 522                 # Check for comment block line
 523                 # -----------------------------
 524                 if ($in_comment_block && ($$line =~ m,^-,)) {
 525                         # Note: We do not check for anything else, as empty lines must be allowed.
 526                         substr($$line, 0, 1) = " ";
 527                         next;
 528                 }
 529
 530                 # If none of the above applied, the comment block is over.
 531                 $in_comment_block = 0;
 532         }
 533
 534         return 1;
 535 }
 536
 537 # -----------------------------------------------------------------------
 538 # --- Check for debug constructs                                      ---
 539 # --- Rules: ENABLE_DEBUG_ELOGIND must be taken like #if 1, *but*     ---
 540 # ---        here an #else is valid and must stay fully.              ---
 541 # ---        Further there might be multiline calls to                ---
 542 # ---        log_debug_elogind() that must not be removed either.     ---
 543 # -----------------------------------------------------------------------
 544 sub check_debug {
 545
 546         # Early exits:
 547         defined($hHunk) or return 0;
 548         $hHunk->{useful} or return 0;
 549
 550         # Count non-elogind block #ifs. This is needed, so normal
 551         # #if/#else/#/endif constructs can be put inside both the
 552         # debug and the release block.
 553         my $regular_ifs   = 0;
 554         my $is_debug_func = 0; ## Special for log_debug_elogind()
 555
 556         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
 557                 my $line = \$hHunk->{lines}[$i]; ## Shortcut
 558
 559                 # Entering a debug construct block
 560                 # ---------------------------------------
 561                 if ( $$line =~ m/^-#if.+ENABLE_DEBUG_ELOGIND/ ) {
 562                         ## Note: Here it is perfectly fine to be in an elogind mask or insert block.
 563                         substr($$line, 0, 1) = " "; ## Remove '-'
 564                         $in_insert_block++; ## Increase instead of setting this to 1.
 565                         next;
 566                 }
 567
 568                 # Count regular #if
 569                 $$line =~ m/^-#if/ and $in_insert_block and ++$regular_ifs;
 570
 571                 # Switching to the release variant.
 572                 # ---------------------------------------
 573                 if ( ($$line =~ m/^-#else/ ) && $in_insert_block && !$regular_ifs) {
 574                         substr($$line, 0, 1) = " "; ## Remove '-'
 575                         $in_else_block++; ## Increase instead of setting this to 1.
 576                         next;
 577                 }
 578
 579                 # Ending a debug construct block
 580                 # ---------------------------------------
 581                 if ( $$line =~ m,^-#endif\s*///?.*ENABLE_DEBUG_, ) {
 582                         (!$in_insert_block)
 583                                 and return hunk_failed("check_debug: #endif // ENABLE_DEBUG_* found outside any debug construct");
 584                         substr($$line, 0, 1) = " "; ## Remove '-'
 585                         $in_insert_block--; ## Decrease instead of setting to 0. This allows such
 586                         $in_else_block--;   ## blocks to reside in regular elogind mask/insert blocks.
 587                         next;
 588                 }
 589
 590                 # End regular #if
 591                 $$line =~ m/^-#endif/ and $in_insert_block and --$regular_ifs;
 592
 593                 # Check for log_debug_elogind()
 594                 # ---------------------------------------
 595                 if ($$line =~ m/^-.*log_debug_elogind\s*\(/ ) {
 596                         substr($$line, 0, 1) = " "; ## Remove '-'
 597                         $$line =~ m/\)\s*;/ or ++$is_debug_func;
 598                         next;
 599                 }
 600
 601                 # Remove '-' prefixes in all lines within the debug construct block
 602                 # -------------------------------------------------------------------
 603                 if ( ($$line =~ m,^-,) && ($in_insert_block || $is_debug_func) ) {
 604                         substr($$line, 0, 1) = " "; ## Remove '-'
 605                         # Note: Everything in *any* insert block must not be removed anyway.
 606                 }
 607
 608                 # Check for the end of a multiline log_debug_elogind() call
 609                 # ---------------------------------------------------------
 610                 $is_debug_func and $$line =~ m/\)\s*;/ and --$is_debug_func;
 611
 612         } ## End of looping lines
 613
 614         return 1;
 615 }
 616
 617 # -----------------------------------------------------------------------
 618 # --- Check for attempts to remove elogind_*() special function calls. --
 619 # --- We have som special functions, needed oly by elogind.           ---
 620 # --- One of the most important ones is elogind_set_program_name(),   ---
 621 # --- which has an important role in musl_libc compatibility.         ---
 622 # --- These calls must not be removed of course.                      ---
 623 # -----------------------------------------------------------------------
 624 sub check_func_removes  {
 625
 626         # Early exits:
 627         defined($hHunk) or return 1;
 628         $hHunk->{useful} or return 1;
 629
 630         # Needed for multi-line calls
 631         my $is_func_call = 0;
 632
 633         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
 634                 my $line = \$hHunk->{lines}[$i]; ## Shortcut
 635
 636                 # Check for elogind_*() call
 637                 # -------------------------------------------------------------------
 638                 if ($$line =~ m/^-.*elogind_\S+\s*\(/ ) {
 639                         substr($$line, 0, 1) = " "; ## Remove '-'
 640                         $$line =~ m/\)\s*;/ or ++$is_func_call;
 641                         next;
 642                 }
 643
 644                 # Remove '-' prefixes in all lines that belong to an elogind_*() call
 645                 # -------------------------------------------------------------------
 646                 if ( ($$line =~ m,^-,) && $is_func_call ) {
 647                         substr($$line, 0, 1) = " "; ## Remove '-'
 648                 }
 649
 650                 # Check for the end of a multiline elogind_*() call
 651                 # -------------------------------------------------------------------
 652                 $is_func_call and $$line =~ m/\)\s*;/ and --$is_func_call;
 653         }
 654
 655         return 1;
 656 }
 657
 658 # -----------------------------------------------------------------------
 659 # --- Check hunk for include manipulations we must step in            ---
 660 # --- This is basically read_include(), but this time we actually act ---
 661 # --- on what we found.                                               ---
 662 # --- Rules:                                                          ---
 663 # --- 1) Removals of includes that we commented out:                  ---
 664 # ---    a) If there is no insertion of this include, let it be       ---
 665 # ---       removed, it seems to be obsolete.                         ---
 666 # ---    b) If there is an insertion of the very same include in one  ---
 667 # ---       of the surrounding lines, mark the insert for splicing    ---
 668 # ---       and undo the removal.                                     ---
 669 # ---    c) If there is an insertion somewhere else, let it be        ---
 670 # ---       removed here, and handle the insertion:                   ---
 671 # ---       - Outside a "needed by elogind" block: comment out the    ---
 672 # ---         inserted include.                                       ---
 673 # ---       - Inside a "needed by elogind" block: undo the removal    ---
 674 # ---         there.                                                  ---
 675 # --- 2) Insertions of new includes, where 1) does not apply:         ---
 676 # ---    a) If the include is new, comment it out to force a later    ---
 677 # ---       check. The compiler will tell us if it is needed.         ---
 678 # ---    b) If the include is part of the "needed by elogind" block   ---
 679 # ---       already, allow the removal there and accept the regular   ---
 680 # ---       insertion here.                                           ---
 681 # --- 3) Removals of includes in "needed by elogind" blocks:          ---
 682 # ---    As 1) and 2) do not apply, simply undo any removal here.     ---
 683 # -----------------------------------------------------------------------
 684 sub check_includes {
 685
 686         # Early exits:
 687         defined($hHunk) or return 1;
 688         $hHunk->{useful} or return 1;
 689
 690         # We must know when "needed by elogind blocks" start
 691         my $in_elogind_block = 0;
 692
 693         # The simple undo check will fail, if we do at least one at once.
 694         # Delay the undoing of the removals until after the hunk was checked.
 695         my %undos = ();
 696
 697         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
 698                 my $line = \$hHunk->{lines}[$i]; ## Shortcut
 699
 700                 # === Ruleset 1 : Handling of removals of includes we commented out ===
 701                 # =====================================================================
 702                 if ( $$line =~ m,^-\s*//+\s*#include\s+[<"']([^>"']+)[>"'], ) {
 703                         $hIncs{$1}{applied} and next; ## No double handling
 704
 705                         my $inc = $1;
 706
 707                         # Pre: Sanity check:
 708                         defined($hIncs{$inc}{remove}{hunkid}) and $hIncs{$inc}{remove}{hunkid} > -1
 709                          or return hunk_failed("check_includes: Unrecorded removal found!");
 710
 711                         # a) Check for removals of obsolete includes.
 712                         $hIncs{$inc}{elogind}{hunkid} > -1        ## If no insert was found, then the include was
 713                                  or $hIncs{$inc}{insert}{hunkid} > -1 ## removed by systemd devs for good.
 714                                  or ( ++$hIncs{$inc}{applied} and next);
 715
 716                         # b) Check for a simple undo of our commenting out
 717                         if ( ($hIncs{$inc}{insert}{hunkid} == $hIncs{$inc}{remove}{hunkid} )
 718                           && ($hIncs{$inc}{insert}{sysinc} == $hIncs{$inc}{remove}{sysinc} ) ) {
 719                                 my $ins_diff  = $hIncs{$inc}{insert}{lineid} - $hIncs{$inc}{remove}{lineid};
 720                                 my $all_same  = 1;
 721                                 my $direction = $ins_diff > 0 ? 1 : -1;
 722
 723                                 # Let's see whether there are undos between this and its addition
 724                                 # in the same order, meaning there has been no resorting.
 725                                 for (my $j = $direction; $all_same && (abs($j) < abs($ins_diff)); $j += $direction) {
 726                                         $all_same = 0;
 727
 728                                         if ( ( $hHunk->{lines}[$i+$j] =~ m,^-\s*//+\s*#include\s+[<"']([^>"']+)[>"'], )
 729                                           || ( $hHunk->{lines}[$i+$j] =~ m,^\+\s*#include\s+[<"']([^>"']+)[>"'], ) ) {
 730
 731                                                 $hIncs{$1}{insert}{hunkid} == $hIncs{$1}{remove}{hunkid}
 732                                                         and $ins_diff == ($hIncs{$1}{insert}{lineid} - $hIncs{$1}{remove}{lineid})
 733                                                         and $hIncs{$inc}{insert}{sysinc} == $hIncs{$inc}{remove}{sysinc}
 734                                                         and $all_same = 1;
 735                                         }
 736                                 }
 737                                 if ($all_same) {
 738                                         # The insertion is right before or after the removal. That's pointless.
 739                                         $undos{$i} = 1;
 740                                         $undos{$hIncs{$inc}{insert}{lineid}} = 1;
 741                                         $hIncs{$inc}{applied}  = 1;
 742                                         $hIncs{$inc}{insert}{spliceme} = 1;
 743                                         next;
 744                                 }
 745                         } ## end of insert and remove being in the same hunk
 746
 747                         # c) Move somewhere else, or change include type. Can't be anything else here.
 748                         if ($hIncs{$inc}{elogind}{hunkid} > -1) {
 749                                 # Just undo the removal of the elogind insert.
 750                                 my $hId = $hIncs{$inc}{elogind}{hunkid};
 751                                 my $lId = $hIncs{$inc}{elogind}{lineid};
 752                                 substr($hFile{hunks}[$hId]{lines}[$lId], 0, 1) = " ";
 753                                 $hIncs{$inc}{applied}  = 1;
 754                         } elsif ( $hIncs{$inc}{insert}{elogind} ) {
 755                                 # Do not move masked includes under our block.
 756                                 $undos{$i} = 1;
 757                                 $hIncs{$inc}{applied}  = 1;
 758                                 $hIncs{$inc}{insert}{spliceme} = 1;
 759                         } else {
 760                                 # Just comment out the insert.
 761                                 my $hId = $hIncs{$inc}{insert}{hunkid};
 762                                 my $lId = $hIncs{$inc}{insert}{lineid};
 763                                 substr($hFile{hunks}[$hId]{lines}[$lId], 0, 1) = "+//";
 764                                 $hIncs{$inc}{applied}  = 1;
 765                         }
 766
 767                         next;
 768                 } ## End of ruleset 1
 769
 770                 # === Ruleset 2 : Handling of insertions, not handled by 1          ===
 771                 # =====================================================================
 772                 if ( $$line =~ m,^\+\s*#include\s+[<"']([^>"']+)[>"'], ) {
 773                         $hIncs{$1}{applied} and next; ## No double handling
 774
 775                         # Pre: Sanity check:
 776                         defined($hIncs{$1}{insert}{hunkid}) and $hIncs{$1}{insert}{hunkid} > -1
 777                          or return hunk_failed("check_includes: Unrecorded insertion found!");
 778
 779                         # Nicely enough we only have to check whether this is removed from
 780                         # any elogind includes block or not.
 781                         (-1 == $hIncs{$1}{elogind}{hunkid})
 782                                 and substr($$line, 0, 1) = "+//"; ## comment out for later check
 783                         $hIncs{$1}{applied}  = 1;
 784
 785                         # That's it. Cool, eh?
 786
 787                         next;
 788                 }
 789
 790                 # === Ruleset 3 : Handling of "needed by elogind" blocks            ===
 791                 # =====================================================================
 792                 if ( $in_elogind_block
 793                   && ($$line =~ m,^-\s*#include\s+[<"']([^>"']+)[>"'], ) ) {
 794                         $hIncs{$1}{applied} and next; ## No double handling
 795
 796                         # Pre: Sanity check:
 797                         defined($hIncs{$1}{elogind}{hunkid}) and $hIncs{$1}{elogind}{hunkid} > -1
 798                          or return hunk_failed("check_includes: Unrecorded elogind include found!");
 799
 800                         # As 1 and 2 do not apply, simply undo the removal.
 801                         substr($$line, 0, 1) = " ";
 802                         $hIncs{$1}{applied} = 1;
 803
 804                         next;
 805                 }
 806
 807                 # === Other 1 : Look for "needed by elogind" block starts           ===
 808                 # =====================================================================
 809                 if ($$line =~ m,^[- ]\s*//+.*needed by elogind.*,i) {
 810                         $in_elogind_block = 1;
 811
 812                         # Never remove the block start
 813                         ($$line =~ m,^-,) and substr($$line, 0, 1) = " ";
 814
 815                         # While we are here, we can see to it, that the additional empty
 816                         # line above our marker does not get removed:
 817                         ($i > 0) and ($hHunk->{lines}[$i-1] =~ m/^-\s*$/)
 818                            and substr($hHunk->{lines}[$i-1], 0, 1) = " ";
 819
 820                         next;
 821                 }
 822
 823                 # === Other 2 : elogind include blocks end, when the first not      ===
 824                 # ===           removed EMPTY line is found                         ===
 825                 # =====================================================================
 826                 $in_elogind_block and ($$line =~ m,^[ +]\s*$,) and $in_elogind_block = 0;
 827
 828                 # === Other 3 : Undo all other removals in elogind include blocks   ===
 829                 # =====================================================================
 830                 $in_elogind_block and ($$line =~ m,^-,) and substr($$line, 0, 1) = " ";
 831
 832                 # Note: Although it looks like all rules are out the window here, all
 833                 #       elogind includes that are handled above, end in a 'next', so
 834                 #       those won't reach here. Actually 'Other 3' would be never
 835                 #       reached with an #include line.
 836
 837         } ## End of looping lines
 838
 839         # Before we can leave, we have to neutralize the %undo lines:
 840         for my $lId (keys %undos) {
 841                 substr($hHunk->{lines}[$lId], 0, 1) = " ";
 842         }
 843
 844         return 1;
 845 }
 846
 847 # -----------------------------------------------------------------------
 848 # --- Check $hHunk for elogind preprocessor masks and additions       ---
 849 # --- Rules:                                                          ---
 850 # --- 1) If we need an alternative for an existing systemd code block,---
 851 # ---    we do it like this:                                          ---
 852 # ---      #if 0 /// <some comment with the word "elogind" in it>     ---
 853 # ---        (... systemd code block, unaltered ...)                  ---
 854 # ---        -> Any change in this block is okay.                     ---
 855 # ---      #else                                                      ---
 856 # ---        (... elogind alternative code ...)                       ---
 857 # ---        -> Any change in this block is *NOT* okay.               ---
 858 # ---      #endif // 0                                                ---
 859 # --- 2) If we need an addition for elogind, we do it like this:      ---
 860 # ---      #if 1 /// <some comment with the word "elogind" in it>     ---
 861 # ---        (... elogind additional code ...)                        ---
 862 # ---        -> Any change in this block is *NOT* okay.               ---
 863 # ---      #endif // 1                                                ---
 864 # -----------------------------------------------------------------------
 865 sub check_masks {
 866
 867         # Early exits:
 868         defined($hHunk) or return 0;
 869         $hHunk->{useful} or return 0;
 870
 871         # Count non-elogind block #ifs. This is needed, so normal
 872         # #if/#else/#/endif constructs can be put inside elogind mask blocks.
 873         my $regular_ifs = 0;
 874
 875         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
 876                 my $line = \$hHunk->{lines}[$i]; ## Shortcut
 877
 878                 # Entering an elogind mask
 879                 # ---------------------------------------
 880                 if ( $$line =~ m/^-#if\s+0.+elogind/ ) {
 881                         $in_mask_block
 882                                 and return hunk_failed("check_masks: Mask start found while being in a mask block!");
 883                         $in_insert_block
 884                                 and return hunk_failed("check_masks: Mask start found while being in an insert block!");
 885                         substr($$line, 0, 1) = " "; ## Remove '-'
 886                         $in_mask_block = 1;
 887                         next;
 888                 }
 889
 890                 # Entering an elogind insert
 891                 # ---------------------------------------
 892                 if ( $$line =~ m/^-#if\s+1.+elogind/ ) {
 893                         $in_mask_block
 894                                 and return hunk_failed("check_masks: Insert start found while being in a mask block!");
 895                         $in_insert_block
 896                                 and return hunk_failed("check_masks: Insert start found while being in an insert block!");
 897                         substr($$line, 0, 1) = " "; ## Remove '-'
 898                         $in_insert_block = 1;
 899                         next;
 900                 }
 901
 902                 # Count regular #if
 903                 $$line =~ m/^-#if/ and $in_mask_block and ++$regular_ifs;
 904
 905                 # Switching from Mask to else.
 906                 # Note: Inserts have no #else, they make no sense.
 907                 # ---------------------------------------
 908                 if ( ($$line =~ m/^-#else/ ) && $in_mask_block && !$regular_ifs) {
 909                         substr($$line, 0, 1) = " "; ## Remove '-'
 910                         $in_else_block = 1;
 911                         next;
 912                 }
 913
 914                 # Ending a Mask/Insert block
 915                 # ---------------------------------------
 916                 # Note: The regex supports "#endif /** 0 **/", too.
 917                 if ( $$line =~ m,^-#endif\s*/(?:[*/]+)\s*([01]), ) {
 918                         if (0 == $1) {
 919                                 (!$in_mask_block)
 920                                         and return hunk_failed("check_masks: #endif // 0 found outside any mask block");
 921                                 substr($$line, 0, 1) = " "; ## Remove '-'
 922                                 $in_mask_block = 0;
 923                                 $in_else_block = 0;
 924                                 next;
 925                         }
 926
 927                         # As we explicitly ask for "#endif // [01]", only one is left.
 928                         (!$in_insert_block)
 929                                 and return hunk_failed("check_masks: #endif // 1 found outside any insert block");
 930                         substr($$line, 0, 1) = " "; ## Remove '-'
 931                         $in_insert_block = 0;
 932                         $in_else_block   = 0;
 933                         next;
 934                 }
 935
 936                 # End regular #if
 937                 $$line =~ m/^-#endif/ and $in_mask_block and --$regular_ifs;
 938
 939                 # Remove '-' prefixes in all lines within insert and mask-else blocks
 940                 # -------------------------------------------------------------------
 941                 if ( ($$line =~ m,^-,)
 942                   && ( $in_insert_block || ($in_mask_block && $in_else_block) ) ) {
 943                         substr($$line, 0, 1) = " "; ## Remove '-'
 944                 }
 945         } ## End of looping lines
 946
 947         return 1;
 948 }
 949
 950 # -----------------------------------------------------------------------
 951 # --- Check for musl_libc compatibility blocks                        ---
 952 # --- Rules:                                                          ---
 953 # --- For musl-libc compatibility, there are some                     ---
 954 # ---   #ifdef __GLIBC__ (...) #else (...) #endif // __GLIBC__        ---
 955 # --- helpers.                                                        ---
 956 # --- These can also be "#if defined(__GLIBC__)"                      ---
 957 # --- Note: We handle them like regular mask blocks, because the      ---
 958 # ---       __GLIBC__ block is considered to be the original, while   ---
 959 # ---       the musl_libc compat block is the #else block.            ---
 960 # -----------------------------------------------------------------------
 961 sub check_musl {
 962
 963         # Early exits:
 964         defined($hHunk) or return 0;
 965         $hHunk->{useful} or return 0;
 966
 967         # Count non-elogind block #ifs. This is needed, so normal
 968         # #if/#else/#/endif constructs can be put inside both the original
 969         # and the alternative block.
 970         my $regular_ifs = 0;
 971
 972         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
 973                 my $line = \$hHunk->{lines}[$i]; ## Shortcut
 974
 975                 # Entering a __GLIBC__ block
 976                 # ---------------------------------------
 977                 if ( $$line =~ m/^-#if.+__GLIBC__/ ) {
 978                         ## Note: Here it is perfectly fine to be in an elogind mask block.
 979                         substr($$line, 0, 1) = " "; ## Remove '-'
 980                         $in_mask_block++; ## Increase instead of setting this to 1.
 981                         next;
 982                 }
 983
 984                 # Count regular #if
 985                 $$line =~ m/^-#if/ and $in_mask_block and ++$regular_ifs;
 986
 987                 # Switching from __GLIBC__ to else - the alternative for musl_libc.
 988                 # ---------------------------------------
 989                 if ( ($$line =~ m/^-#else/ ) && $in_mask_block && !$regular_ifs) {
 990                         substr($$line, 0, 1) = " "; ## Remove '-'
 991                         $in_else_block++; ## Increase instead of setting this to 1.
 992                         next;
 993                 }
 994
 995                 # Ending a __GLBC__ block
 996                 # ---------------------------------------
 997                 if ( $$line =~ m,^-#endif\s*///?.*__GLIBC__, ) {
 998                         (!$in_mask_block)
 999                                 and return hunk_failed("check_musl: #endif // __GLIBC__ found outside any __GLIBC__ block");
1000                         substr($$line, 0, 1) = " "; ## Remove '-'
1001                         $in_mask_block--; ## Decrease instead of setting to 0. This allows such
1002                         $in_else_block--; ## blocks to reside in regular elogind mask/insert blocks.
1003                         next;
1004                 }
1005
1006                 # End regular #if
1007                 $$line =~ m/^-#endif/ and $in_mask_block and --$regular_ifs;
1008
1009                 # Remove '-' prefixes in all lines within the musl (#else) blocks
1010                 # -------------------------------------------------------------------
1011                 if ( ($$line =~ m,^-,) && $in_mask_block && $in_else_block ) {
1012                         substr($$line, 0, 1) = " "; ## Remove '-'
1013                 }
1014         } ## End of looping lines
1015
1016         return 1;
1017 }
1018
1019 # -----------------------------------------------------------------------
1020 # --- Check for attempts to revert 'elogind' to 'systemd'             ---
1021 # --- Note: We only check for single line reverts like:               ---
1022 # --- |-  // This is how elogind does it                              ---
1023 # --- |+  // This is how systemd does it                              ---
1024 # -----------------------------------------------------------------------
1025 sub check_name_reverts {
1026
1027         # Early exits:
1028         defined($hHunk) or return 0;
1029         $hHunk->{useful} or return 0;
1030
1031         # Note down what is changed, so we can have inline updates
1032         my %hRemovals = ();
1033
1034         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
1035                 my $line = \$hHunk->{lines}[$i]; ## Shortcut
1036
1037                 defined($$line) or return hunk_failed("check_name_reverts: Line " . ($i + 1) . "/$hHunk->{count} is undef?\n");
1038
1039                 # Note down removals
1040                 # ---------------------------------
1041                 if ($$line =~ m/^-\s*(.*elogind.*)\s*$/) {
1042                         $hRemovals{$1}{line} = $i;
1043                         next;
1044                 }
1045
1046                 # Check Additions
1047                 # ---------------------------------
1048                 if ($$line =~ m/^\+\s*(.*systemd.*)\s*$/) {
1049                         my $replace_text   = $1;
1050                         my $our_text_long  = $replace_text;
1051                         my $our_text_short = $our_text_long;
1052                         $our_text_long  =~ s/systemd-logind/elogind/g;
1053                         $our_text_short =~ s/systemd/elogind/g;
1054
1055                         # There is one speciality:
1056                         # In some meson files, we need the variable "systemd_headers".
1057                         # This refers to the systemd API headers that get installed,
1058                         # and must therefore not be renamed to elogind_headers.
1059                         $our_text_short =~ s/elogind_headers/systemd_headers/g;
1060
1061                         # If this is a simple switch, undo it:
1062                         if ( defined($hRemovals{$our_text_short})
1063                           || defined($hRemovals{$our_text_long }) ) {
1064                                 defined($hRemovals{$our_text_short} )
1065                                         and substr($hHunk->{lines}[$hRemovals{$our_text_short}{line}], 0, 1) = " "
1066                                          or substr($hHunk->{lines}[$hRemovals{$our_text_long }{line}], 0, 1) = " ";
1067                                 splice(@{$hHunk->{lines}}, $i--, 1);
1068                                 $hHunk->{count}--;
1069                                 next;
1070                         }
1071
1072                         # Otherwise replace the addition with our text. ;-)
1073                         $our_text_long eq $replace_text
1074                                 and $$line =~ s/^\+(\s*).*systemd.*(\s*)$/+${1}${our_text_short}${2}/
1075                                  or $$line =~ s/^\+(\s*).*systemd.*(\s*)$/+${1}${our_text_long }${2}/;
1076                 }
1077         }
1078
1079         return 1;
1080 }
1081
1082 # -----------------------------------------------------------------------
1083 # --- Checkout the given refid on $upstream_path                      ---
1084 # --- Returns 1 on success, 0 otherwise.                              ---
1085 # -----------------------------------------------------------------------
1086 sub checkout_upstream {
1087         my ($commit)   = @_;
1088         my $errmsg     = "";
1089         my $new_commit = "";
1090
1091         # It is completely in order to not wanting to checkout a specific commit.
1092         defined($commit) and length($commit) or return 1;
1093
1094         # Save the previous commit
1095         $previous_commit = qx(cd $upstream_path ; git rev-parse --short HEAD 2>&1);
1096         if ($?) {
1097                 print "ERROR: Couldn't rev-parse $upstream_path HEAD\n";
1098                 print "Exit Code : " . ($? >> 8) . "\n";
1099                 print "$previous_commit\n";
1100                 return 0;
1101         }
1102
1103         # Get the shortened commit hash of $commit
1104         $new_commit = qx(cd $upstream_path ; git rev-parse --short "$commit" 2>&1);
1105         if ($?) {
1106                 print "ERROR: Couldn't rev-parse $upstream_path \"$commit\"\n";
1107                 print "Exit Code : " . ($? >> 8) . "\n";
1108                 print "$new_commit\n";
1109                 return 0;
1110         }
1111
1112         # Now check it out, unless we are already there:
1113         if ($previous_commit ne $new_commit) {
1114                 $errmsg = qx(cd $upstream_path ; git checkout "$new_commit" 2>&1);
1115                 if ($?) {
1116                         print "ERROR: Couldn't checkout \"new_commit\" in $upstream_path\n";
1117                         print "Exit Code : " . ($? >> 8) . "\n";
1118                         print "$errmsg\n";
1119                         return 0;
1120                 }
1121         }
1122
1123         return 1;
1124 }
1125
1126 # -----------------------------------------------------------------------
1127 # --- Completely clean up the current %hFile data structure.          ---
1128 # -----------------------------------------------------------------------
1129 sub clean_hFile {
1130         defined($hFile{count}) or return 1;
1131
1132         for (my $i = $hFile{count} - 1; $i > -1; --$i) {
1133                 defined($hFile{hunks}[$i]) and undef(%{$hFile{hunks}[$i]});
1134         }
1135
1136         $hFile{count}  = 0;
1137         $hFile{hunks}  = [ ];
1138         $hFile{output} = [ ];
1139
1140         return 1;
1141 }
1142
1143 # -----------------------------------------------------------------------
1144 # --- Builds the diff between source and target file, and stores all  ---
1145 # --- hunks in $hFile{hunks} - if any.                                ---
1146 # --- Returns 1 on success and 0 if the files are the same.           ---
1147 # -----------------------------------------------------------------------
1148 sub diff_hFile {
1149
1150         # Do they differ at all?
1151         `diff -qu "$hFile{source}" "$hFile{target}" 1>/dev/null 2>&1`;
1152         $? or print "same\n" and return 0;
1153
1154         # Shell and meson files must be prepared. See prepare_meson()
1155         ( $hFile{source} =~ m/meson/ or
1156           $hFile{source} =~ m/\.gperf$/ or
1157           $hFile{source} =~ m/\.in$/ or
1158           $hFile{source} =~ m/\.pl$/ or
1159           $hFile{source} =~ m/\.sh$/ ) and prepare_shell;
1160
1161         # Let's have two shortcuts:
1162         my $src = $hFile{source};
1163         my $tgt = $hFile{target};
1164         my $prt = $hFile{part};
1165
1166         # Now the diff can be built ...
1167         my @lDiff = `diff -u "$src" "$tgt"`;
1168
1169         # ... the head of the output can be generated ...
1170         @{$hFile{output}} = splice(@lDiff, 0, 2);
1171         chomp $hFile{output}[0]; # These now have absolute paths, and source meson files have a
1172         chomp $hFile{output}[1]; # .pwx extensions. That is not what the result shall look like.
1173         $hFile{output}[0] =~ s,$src,a/$prt,; # But we have $hFile{part}, which is already the
1174         $hFile{output}[1] =~ s,$tgt,b/$prt,; # relative file name of the file we are processing.
1175
1176         # ... and the raw hunks can be stored.
1177         for (my $line_no  = 1; $line_no < scalar @lDiff; ++$line_no) {
1178                 ("@@" eq substr($lDiff[$line_no], 0, 2))
1179                         and (build_hHunk(splice(@lDiff, 0, $line_no)) or return 0)
1180                         and $line_no = 0;
1181         }
1182         scalar @lDiff and build_hHunk(@lDiff);
1183
1184         return 1;
1185 }
1186
1187 # -----------------------------------------------------------------------
1188 # --- Finds all relevant files and store them in @wanted_files        ---
1189 # --- Returns 1 on success, 0 otherwise.                              ---
1190 # -----------------------------------------------------------------------
1191 sub generate_file_list {
1192
1193         # Do some cleanup first. Just to be sure.
1194         `rm -rf build`;
1195         `find -iname '*.orig' -or -iname '*.bak' -or -iname '*.rej' -or -iname '*~' -or -iname '*.gc??' | xargs rm -f`;
1196
1197         # Build wanted files hash
1198         while (my $want = shift @wanted_files) {
1199                 $want =~ m,^\./, or $want = "./$want";
1200                 $hWanted{$want} = 1;
1201                 $want           =~ s/elogind/systemd/g;
1202                 $hWanted{$want} = 1;
1203                 $have_wanted    = 1;
1204         }
1205
1206         # The idea now is, that we use File::Find to search for files
1207         # in all legal directories this program allows. Checking against
1208         # the built %hWanted ensures that a user provided list of files
1209         # is heeded.
1210         for my $xDir ("docs", "factory", "m4", "man", "shell-completion", "src", "tools") {
1211                 if ( -d "$xDir" ) {
1212                         find(\&wanted, "$xDir");
1213                 }
1214         }
1215
1216         # Just to be sure...
1217         scalar @source_files
1218                  or print("ERROR: No source files found? Where the hell are we?\n")
1219                 and return 0;
1220
1221         # Get the maximum file length and build $file_fmt
1222         my $mlen = 0;
1223         for my $f (@source_files) {
1224                 length($f) > $mlen and $mlen = length($f);
1225         }
1226         $file_fmt = sprintf("%%-%d%s", $mlen, "s");
1227
1228         return 1;
1229 }
1230
1231 # ------------------------------------------------------------------------
1232 # --- Generate the "@@ -xx,n +yy,m @@" hunk header line out of $hHunk. ---
1233 # --- Returns the generated string, with 0 values if $hHunk is undef.  ---
1234 # --- IMPORTANT: This function does *NOT* prune $hHunk->{lines} !      ---
1235 # ------------------------------------------------------------------------
1236 sub get_hunk_head {
1237         my ($offset) = @_;
1238
1239         my $src_len   = 0;
1240         my $tgt_len   = 0;
1241         my $lCount    = $hHunk->{count};
1242         my $src_start = $hHunk->{src_start};
1243         my $tgt_start = defined($offset) ? $src_start + $$offset : $hHunk->{tgt_start};
1244
1245         for (my $i = 0; $i < $lCount; ++$i) {
1246                 if ($hHunk->{lines}[$i] =~ m/^\+/ ) {
1247                         $tgt_len++;
1248                 } elsif ($hHunk->{lines}[$i] =~ m/^\-/ ) {
1249                         $src_len++;
1250                 } else {
1251                         $src_len++;
1252                         $tgt_len++;
1253                 }
1254         }
1255
1256         # If an offset reference was given, add back the size diff
1257         defined($offset)
1258                 and $$offset += $tgt_len - $src_len;
1259
1260         return sprintf("@@ -%d,%d +%d,%d @@", $src_start, $src_len, $tgt_start, $tgt_len);
1261 }
1262
1263 # -----------------------------------------------------------------------
1264 # --- Whenever a check finds an illegal situation, it has to call     ---
1265 # --- this subroutine which terminates the progress line and creaes   ---
1266 # --- an entry in @lFails.                                            ---
1267 # --- Param: An error message, preferably with the name of the failed ---
1268 # ---        check.                                                   ---
1269 # --- Return: Always zero.                                            ---
1270 # -----------------------------------------------------------------------
1271 sub hunk_failed {
1272         my ($msg) = @_;
1273         my $num   = scalar @lFails;
1274
1275         # Generate entry:
1276         push @lFails, {
1277                 hunk => [ get_hunk_head ],
1278                 msg  => $msg,
1279                 part => $hFile{part}
1280         };
1281
1282         # Add the hunk itself
1283         for my $line (@{$hHunk->{lines}}) {
1284                 push @{$lFails[$num]{hunk}}, $line;
1285         }
1286
1287         # And terminate the progress line:
1288         print "$msg\n";
1289
1290         return 0;
1291 }
1292
1293 # -----------------------------------------------------------------------
1294 # --- Check the current $hHunk whether it still does anything.        ---
1295 # --- While being at it, prune it to what a diff needs:               ---
1296 # ---   3 lines before the first and 3 lines after the last change.   ---
1297 # --- Returns 1 if at least one change was found, 0 otherwise.        ---
1298 # -----------------------------------------------------------------------
1299 sub hunk_is_useful {
1300
1301         # Early exits:
1302         defined($hHunk) or return 0;
1303         $hHunk->{useful} or return 0;
1304
1305         # Go through the lines and see whether we have any changes
1306         $hHunk->{useful} = 0;
1307
1308         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
1309                 if ($hHunk->{lines}[$i] =~ m/^[-+]/ ) {
1310                         $hHunk->{useful} = 1;
1311                         return 1;
1312                 }
1313         }
1314
1315         return 0;
1316 }
1317
1318 # -----------------------------------------------------------------------
1319 # --- parse the given list for arguments.                             ---
1320 # --- returns 1 on success, 0 otherwise.                              ---
1321 # --- sets global $show_help to 1 if the long help should be printed. ---
1322 # -----------------------------------------------------------------------
1323 sub parse_args {
1324         my @args      = @_;
1325         my $result    = 1;
1326
1327         for (my $i = 0; $i < @args; ++$i) {
1328
1329                 # Check for -c|--commit option
1330                 # -------------------------------------------------------------------------------
1331                 if ($args[$i] =~ m/^-(?:c|-commit)$/) {
1332                         if ( ( ($i + 1) >= @args )
1333                           || ( $args[$i+1] =~ m,^[-/.], ) ) {
1334                                 print "ERROR: Option $args[$i] needs a refid as argument!\n\nUsage: $USAGE_SHORT\n";
1335                                 $result = 0;
1336                                 next;
1337                         }
1338                         $wanted_commit = $args[++$i];
1339                 }
1340
1341                 # Check for -f|--file option
1342                 # -------------------------------------------------------------------------------
1343                 elsif ($args[$i] =~ m/^-(?:f|-file)$/) {
1344                         if ( ( ($i + 1) >= @args )
1345                           || ( $args[$i+1] =~ m,^[-], ) ) {
1346                                 print "ERROR: Option $args[$i] needs a path as argument!\n\nUsage: $USAGE_SHORT\n";
1347                                 $result = 0;
1348                                 next;
1349                         }
1350                         push @wanted_files, split(/,/, $args[++$i]);
1351                 }
1352
1353                 # Check for -h|--help option
1354                 # -------------------------------------------------------------------------------
1355                 elsif ($args[$i] =~ m/^-(?:h|-help)$/) {
1356                         $show_help = 1;
1357                 }
1358
1359                 # Check for unknown options:
1360                 # -------------------------------------------------------------------------------
1361                 elsif ($args[$i] =~ m/^-/) {
1362                         print "ERROR: Unknown option \"$args[$1]\" encountered!\n\nUsage: $USAGE_SHORT\n";
1363                         $result = 0;
1364                 }
1365
1366                 # Everything else is considered to the path to upstream
1367                 # -------------------------------------------------------------------------------
1368                 else {
1369                         # But only if it is not set, yet:
1370                         if (length($upstream_path)) {
1371                                 print "ERROR: Superfluous upstream path \"$args[$i]\" found!\n\nUsage: $USAGE_SHORT\n";
1372                                 $result = 0;
1373                                 next;
1374                         }
1375                         if ( ! -d "$args[$i]") {
1376                                 print "ERROR: Upstream path \"$args[$i]\" does not exist!\n\nUsage: $USAGE_SHORT\n";
1377                                 $result = 0;
1378                                 next;
1379                         }
1380                         $upstream_path = $args[$i];
1381                 }
1382         } ## End looping arguments
1383
1384         # If we have no upstream path now, show short help.
1385         if ($result && !$show_help && !length($upstream_path)) {
1386                 print "ERROR: Please provide a path to upstream!\n\nUsage: $USAGE_SHORT\n";
1387                 $result = 0;
1388         }
1389
1390         # If any of the wanted files do not exist, error out.
1391         if ($result && !$show_help && defined($wanted_files[0])) {
1392                 foreach my $f (@wanted_files) {
1393                         -f $f or print "ERROR: $f does not exist!\n" and $result = 0;
1394                 }
1395         }
1396
1397         return $result;
1398 } ## parse_srgs() end
1399
1400 # -----------------------------------------------------------------------
1401 # --- Prepare shell and meson files for our processing.               ---
1402 # --- If this is a shell or meson file, we have to adapt it first:    ---
1403 # --- To be able to use our patch building system, the files use the  ---
1404 # --- same masking technology as the C files. But as these are not    ---
1405 # --- handled by any preprocessor, it is necessary to comment out all ---
1406 # --- masked blocks.                                                  ---
1407 # --- If we do not do this, diff creates patches which move all       ---
1408 # --- commented blocks behind the #endif and uncomment them.          ---
1409 # -----------------------------------------------------------------------
1410 sub prepare_shell {
1411         my $in   = $hFile{source};
1412         my $out  = $in . ".pwx";
1413         my @lIn  = ();
1414         my @lOut = ();
1415
1416         # Leech the source file
1417         if (open(my $fIn, "<", $in)) {
1418                 @lIn = <$fIn>;
1419                 close($fIn);
1420         } else {
1421                 die("$in can not be opened for reading! [$!]");
1422         }
1423
1424         # Now prepare the output, line by line.
1425         my $is_block = 0;
1426         my $is_else  = 0;
1427         my $line_no  = 0;
1428         for my $line (@lIn) {
1429
1430                 chomp $line;
1431                 ++$line_no;
1432
1433                 if ($line =~ m,^[ ]?#if 0 /* .*elogind.*,) {
1434                         if ($is_block) {
1435                                 print "ERROR: $in:$line_no : Mask start in mask!\n";
1436                                 die("Illegal file");
1437                         }
1438                         $is_block = 1;
1439                 } elsif ($is_block && ($line =~ m,^[ ]?#else,) ) {
1440                         $is_else = 1;
1441                 } elsif ($line =~ m,^[ ]?#endif /* 0,) {
1442                         if (!$is_block) {
1443                                 print "ERROR: $in:$line_no : Mask end outside mask!\n";
1444                                 die("Illegal file");
1445                         }
1446                         $is_block = 0;
1447                         $is_else  = 0;
1448                 } elsif ($is_block && !$is_else) {
1449                         $line =~ s,^#\s?,,;
1450                 }
1451
1452                 push @lOut, $line;
1453         }
1454
1455         # Now write the outfile:
1456         if (open(my $fOut, ">", $out)) {
1457                 for my $line (@lOut) {
1458                         print $fOut "$line\n";
1459                 }
1460                 close($fOut);
1461         } else {
1462                 die("$out can not be opened for writing! [$!]");
1463         }
1464
1465         # The temporary file is our new source
1466         $hFile{source} = $out;
1467
1468         return 1;
1469 }
1470
1471 # -----------------------------------------------------------------------
1472 # --- Remove unused prefix and postfix lines. Recalculates offsets.   ---
1473 # -----------------------------------------------------------------------
1474 sub prune_hunk {
1475
1476         # Early exits:
1477         defined($hHunk) or return 0;
1478         $hHunk->{useful} or return 0;
1479
1480         # Go through the lines and see what we've got.
1481         my $prefix  = 0;
1482         my $postfix = 0;
1483         my $changed = 0; ## Set to 1 once the first change was found.
1484
1485         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
1486                 if ($hHunk->{lines}[$i] =~ m/^[-+]/ ) {
1487                         $changed = 1;
1488                         $postfix = 0;
1489                 } else {
1490                         $changed or ++$prefix;
1491                         ++$postfix;
1492                 }
1493         }
1494
1495         # Now let's prune it:
1496         if ($prefix > 3) {
1497                 $prefix -= 3;
1498                 splice(@{$hHunk->{lines}}, 0, $prefix);
1499                 $hHunk->{src_start} += $prefix;
1500                 $hHunk->{count}     -= $prefix;
1501         }
1502         if ($postfix > 3) {
1503                 $postfix -= 3;
1504                 splice(@{$hHunk->{lines}}, $hHunk->{count} - $postfix, $postfix);
1505                 $hHunk->{count}     -= $postfix;
1506         }
1507
1508         return 1;
1509 }
1510
1511 # -----------------------------------------------------------------------
1512 # --- Unprepare shell (and meson) files after our processing          ---
1513 # --- In prepare_shell() we have commented in all content between our ---
1514 # --- elogind markers, to help diff not to juggle our blocks around.  ---
1515 # --- Now these blocks must be commented out again.                   ---
1516 # --- We have an advantage and a disadvantage here. On one hand, we   ---
1517 # --- can do the changes within $hFile{output}, as that is the final  ---
1518 # --- patch. On the other hand, we do not know whether really all     ---
1519 # --- lines in the source where commented out. The latter means, that ---
1520 # --- if we blindly comment out all block lines, the resulting patch  ---
1521 # --- may fail. We therefore write the temporary .pwx file back, and  ---
1522 # --- and ensure that all lines are commented out.                    ---
1523 # -----------------------------------------------------------------------
1524 sub unprepare_shell {
1525         my $in   = $hFile{source};
1526         my $out  = substr($in, 0, -4);
1527         my @lIn  = ();
1528         my @lOut = ();
1529
1530         # Leech the temporary file
1531         if (open(my $fIn, "<", $in)) {
1532                 @lIn = <$fIn>;
1533                 close($fIn);
1534         } else {
1535                 die("$in can not be opened for reading! [$!]");
1536         }
1537
1538         # Now prepare the output, line by line.
1539         my $is_block = 0;
1540         my $is_else  = 0;
1541         my $line_no  = 0;
1542         for my $line (@lIn) {
1543
1544                 chomp $line;
1545                 ++$line_no;
1546
1547                 if ($line =~ m,^[ ]?#if 0 /* .*elogind.*,) {
1548                         if ($is_block) {
1549                                 print "ERROR: $in:$line_no : Mask start in mask!\n";
1550                                 die("Illegal file");
1551                         }
1552                         $is_block = 1;
1553                 } elsif ($is_block && ($line =~ m,^[ ]?#else,) ) {
1554                         $is_else = 1;
1555                 } elsif ($line =~ m,^[ ]?#endif /* 0,) {
1556                         if (!$is_block) {
1557                                 print "ERROR: $in:$line_no : Mask end outside mask!\n";
1558                                 die("Illegal file");
1559                         }
1560                         $is_block = 0;
1561                         $is_else  = 0;
1562                 } elsif ($is_block && !$is_else
1563                      && ("# " ne substr($line, 0, 2)) ) {
1564                         $line = "# " . $line;
1565                 }
1566
1567                 push @lOut, $line;
1568         }
1569
1570         # Now write the outfile:
1571         if (open(my $fOut, ">", $out)) {
1572                 for my $line (@lOut) {
1573                         print $fOut "$line\n";
1574                 }
1575                 close($fOut);
1576         } else {
1577                 die("$out can not be opened for writing! [$!]");
1578         }
1579
1580         # Remove the temporary file
1581         unlink($in);
1582
1583         # Now prepare the patch. It is like above, but with less checks.
1584         # We have to move out the lines first, and then write them back.
1585         @lIn = ();
1586         $is_block = 0;
1587         $is_else  = 0;
1588         @lIn = splice(@{$hFile{output}});
1589         for my $line (@lIn) {
1590                 $line =~ m,^[ ]+#endif /* 0, and $is_block = 0;
1591                 $is_block or $is_else = 0;
1592                 $line =~ m,^[ ]+#if 0 /* .*elogind.*, and $is_block = 1;
1593                 $is_block and $line =~ m,^[ ]?#else, and $is_else = 1;
1594                 $is_block and (!$is_else) and (" # " ne substr($line, 0, 2))
1595                         and $line = " #" . $line;
1596
1597                 push @{$hFile{output}}, $line;
1598         }
1599
1600         # Now source is the written back original:
1601         $hFile{source} = $out;
1602
1603         return 1;
1604 }
1605
1606 # -----------------------------------------------------------------------
1607 # --- Analyze the hunk and map all include changes                    ---
1608 # --- The gathered knowledge is used in check_includes(), see there   ---
1609 # --- for the rules applied.                                          ---
1610 # -----------------------------------------------------------------------
1611 sub read_includes {
1612
1613         # Early exits:
1614         defined($hHunk) or return 1;
1615         $hHunk->{useful} or return 1;
1616
1617         # We must know when "needed by elogind blocks" start
1618         my $in_elogind_block = 0;
1619         for (my $i = 0; $i < $hHunk->{count}; ++$i) {
1620                 my $line = \$hHunk->{lines}[$i]; ## Shortcut
1621                 # Note down removes of includes we commented out
1622                 if ( $$line =~ m,^-\s*//+\s*#include\s+([<"'])([^>"']+)[>"'], ) {
1623                         $hIncs{$2}{remove} = { hunkid => $hHunk->{idx}, lineid => $i, sysinc => $1 eq "<" };
1624                         next;
1625                 }
1626
1627                 # Note down inserts of possibly new includes we might want commented out
1628                 if ( $$line =~ m,^\+\s*#include\s+([<"'])([^>"']+)[>"'], ) {
1629                         $hIncs{$2}{insert} = {
1630                                 elogind  => $in_elogind_block,
1631                                 hunkid   => $hHunk->{idx},
1632                                 lineid   => $i,
1633                                 spliceme => 0,
1634                                 sysinc   => $1 eq "<"
1635                         };
1636                         next;
1637                 }
1638
1639                 # Note down removals of includes we explicitly added for elogind
1640                 if ( $in_elogind_block
1641                   && ($$line =~ m,^-\s*#include\s+([<"'])([^>"']+)[>"'], ) ) {
1642                         $hIncs{$2}{elogind} = { hunkid => $hHunk->{idx}, lineid => $i };
1643                         next;
1644                 }
1645
1646                 # elogind include blocks are started by a comment featuring "needed by elogind"
1647                 if ($$line =~ m,^[ -]\s*/+.*needed by elogind.*,i) {
1648                         $in_elogind_block = 1;
1649                         next;
1650                 }
1651
1652                 # elogind include blocks end, when the first not removed *EMPTY* line is found
1653                 $in_elogind_block and ($$line =~ m,^[ ]\s*$,) and $in_elogind_block = 0;
1654         }
1655
1656         return 1;
1657 }
1658
1659 # -----------------------------------------------------------------------
1660 # --- Splice all includes that were marked for splicing.              ---
1661 # --- This is not as easy as it seems. It can be, that if we just go  ---
1662 # --- through the %hIncs keys, that we splice one include that is     ---
1663 # --- before another. That leads to the wrong line to be spliced, or  ---
1664 # --- worse, the splicing being attempted out of bounds.              ---
1665 # -----------------------------------------------------------------------
1666 sub splice_includes {
1667
1668         # First build a tree of the includes to splice:
1669         my %incMap = ();
1670         for my $inc (keys %hIncs) {
1671                 if ($hIncs{$inc}{insert}{spliceme}) {
1672                         my $hId = $hIncs{$inc}{insert}{hunkid};
1673                         my $lId = $hIncs{$inc}{insert}{lineid};
1674
1675                         # Sanity checks:
1676                         $hId > -1 or print "splice_includes : Inc $inc has Hunk Id -1!\n" and next;
1677                         if ( -1 == $lId ) {
1678                                 $hHunk = $hFile{hunks}[$hId];
1679                                 hunk_failed("splice_includes: $inc has line id -1!");
1680                                 next;
1681                         }
1682                         if ( $lId >= $hFile{hunks}[$hId]{count} ) {
1683                                 $hHunk = $hFile{hunks}[$hId];
1684                                 hunk_failed("splice_includes: $inc line id $lId/$hFile{hunks}[$hId]{count}!");
1685                                 next;
1686                         }
1687
1688                         # Record the include line
1689                         $incMap{$hId}{$lId} = 1;
1690                 }
1691         }
1692
1693         # Now we can do the splicing in an ordered way:
1694         for my $hId (sort { $a <=> $b } keys %incMap) {
1695                 # Go through the lines in reverse, that should be save:
1696                 for my $lId (sort { $b <=> $a } keys %{$incMap{$hId}}) {
1697                         splice(@{$hFile{hunks}[$hId]{lines}}, $lId, 1);
1698                         $hFile{hunks}[$hId]{count}--;
1699                 }
1700         }
1701
1702         return 1;
1703 }
1704
1705 # Callback function for File::Find
1706 sub wanted {
1707         -f $_ and ( (0 == $have_wanted)
1708                  or defined($hWanted{$File::Find::name})
1709                  or defined($hWanted{"./$File::Find::name"}) )
1710               and (! ($_ =~ m/\.pwx$/ ))
1711               and push @source_files, $File::Find::name;
1712         return 1;
1713 }