1#!/usr/bin/perl 2 3use strict; 4use warnings; 5use Text::Tabs qw(expand unexpand); 6 7=head1 NAME 8 9Porting/manifest_lib.pl - functions for managing manifests 10 11=head1 SYNOPSIS 12 13 require './Porting/manifest_lib.pl'; 14 15=head1 DESCRIPTION 16 17This file makes available one function, C<sort_manifest()>. 18 19=head2 C<sort_manifest> 20 21Treats its arguments as (chomped) lines from a MANIFEST file, and returns that 22listed sorted appropriately. 23 24=cut 25 26# Try to get a sane sort. case insensitive, more or less 27# sorted such that path components are compared independently, 28# and so that lib/Foo/Bar sorts before lib/Foo-Alpha/Baz 29# and so that lib/Foo/Bar.pm sorts before lib/Foo/Bar/Alpha.pm 30# and so that configure and Configure sort together. 31sub sort_manifest { 32 my @lines = @_; 33 34 # first we ensure that the descriptions for the files 35 # are lined up reasonably. 36 my %pfx_len; 37 my @line_tuples; 38 foreach my $idx (0 .. $#lines) { 39 my $line = $lines[$idx]; 40 # clean up tab/space issues 41 $line =~ s/\t[ ]+/\t/; 42 if ($line =~ s/^(\S+)([ ]\s+)(\S+.*)/$1\t/) { 43 my $descr = $2; 44 $descr =~ s/\t+/ /g; 45 $line .= $descr; 46 } 47 $line =~ s/\s+\z//; 48 $line =~ /^(\S+)(?:\t+([^\t]*))?\z/ 49 or do { 50 $line =~ s/\t/\\t/g; 51 die "Malformed content in MANIFEST at line $idx: '$line'\n", 52 "Note: tabs have been encoded as \\t in this message.\n"; 53 }; 54 my ($file, $descr) = ($1, $2); 55 my $pfx; 56 if ($file =~ m!^((?:[^/]+/){1,2})!) { 57 $pfx = $1; 58 } else { 59 $pfx = ""; 60 } 61 #print "'$pfx': $file\n"; 62 push @line_tuples, [$pfx, $file, $descr]; 63 $pfx_len{$pfx} //= 40; 64 65 # ensure we have at least one "space" (really tab) 66 my $flen = 1 + length $file; 67 $pfx_len{$pfx} = $flen 68 if $pfx_len{$pfx} < $flen; 69 } 70 71 # round up to the next tab stop 72 $_ % 8 and $_ += (8 - ($_ % 8)) for values %pfx_len; 73 74 my @pretty_lines; 75 foreach my $tuple (@line_tuples) { 76 my ($pfx, $file, $descr) = @$tuple; 77 my $str = sprintf "%*s", -$pfx_len{$pfx}, $file; 78 ($str) = unexpand($str); 79 # I do not understand why this is necessary. Bug in unexpand()? 80 # See https://github.com/ap/Text-Tabs/issues/5 81 $str =~ s/[ ]+/\t/; 82 if ($descr) { 83 $str =~ s/\t?\z/\t/; 84 $str .= $descr; 85 } 86 $str =~ s/\s+\z//; 87 push @pretty_lines, $str; 88 } 89 90 @pretty_lines = 91 # case insensitive sorting of directory components independently. 92 map { $_->[0] } # extract the full line 93 sort { 94 $a->[2] cmp $b->[2] || # sort by the first directory 95 $a->[1] cmp $b->[1] || # sort in order of munged filename 96 $a->[0] cmp $b->[0] # then by the exact text in full line 97 } 98 map { 99 # split out the filename and the description 100 my ($f) = split /\s+/, $_, 2; 101 # extract out the first directory 102 my $d = $f=~m!^(\w+/)! ? lc $1 : ""; 103 # lc the filename so Configure and configure sort together in the list 104 my $m= lc $f; # $m for munged 105 # replace slashes by nulls, this makes short directory names sort before 106 # longer ones, such as "foo/" sorting before "foo-bar/" 107 $m =~ s!/!\0!g; 108 # replace the extension (only one) by null null extension. 109 # this puts any foo/blah.ext before any files in foo/blah/ 110 $m =~ s{(?<!\A)(\.[^.]+\z)}{\0\0$1}; 111 112 # return the original string, and the munged filename, and root dir 113 [ $_, $m, $d ]; 114 } @pretty_lines; 115 116 return @pretty_lines; 117} 118 1191; 120 121# ex: set ts=8 sts=4 sw=4 et: 122