Perl x Open Food Facts Hackathon: Paris, France - May 24-25 Learn more

#!/usr/bin/perl -w
use strict;
# $Id: makeppinfo,v 1.3 2007/10/22 19:04:31 pfeiffer Exp $
our $VERSION = '@VERSION@';
use Config;
use POSIX ();
#
# Exiting
#
# Do this early, because the END block defined below shall be the first seen
# by perl, such that it is the last executed. It leaves the process via
# POSIX::_exit, so that no expensive garbage collection of FileInfos occurs.
# All other places can use die or normal exit. If you define additional END
# blocks in any module, you must take care to not reset $?.
#
END {
close STDOUT; close STDERR;
POSIX::_exit $?;
}
our $datadir;
BEGIN {
#@@setdatadir
#
# Find the location of our data directory that contains the auxiliary files.
# This is normally built into the program by install.pl, but if makepp hasn't
# been installed, then we look in the directory we were run from.
#
$datadir = $0; # Assume it's running from the same place that
# we're running from.
unless ($datadir =~ s@/[^/]+$@@) { # No path specified?
# See if we can find ourselves in the path.
foreach (split(/:/, $ENV{'PATH'}), '.') {
# Add '.' to the path in case the user is
# running it with "perl makeppclean" even if
# . is not in his path.
if (-f "$_/FileInfo.pm") { # Found something we need?
$datadir = $_;
last;
}
}
}
$datadir or die "makepp: can't find library files\n";
$datadir = eval "use Cwd; cwd . '/$datadir'"
if $datadir =~ /^\./; # Make it absolute, if it's a relative path.
#@@
unshift @INC, $datadir;
}
use Utils;
use FileInfo qw(file_info file_exists relative_filename);
my( $keylist, $quiet, $traverse, @keys_not, @keys );
TextSubs::getopts
['k', qr/key(?:s|list)/, \$keylist, 1],
[qw'q quiet', \$quiet],
[qw't traverse', \$traverse],
[undef, 'version', undef, undef, \&FileInfo::version],
[qr/[h?]/, 'help', undef, undef, \&usage];
$SIG{__WARN__} = sub {} if $quiet && $quiet > 1;
for( $keylist ) {
last if !defined;
tr/a-z/A-Z/;
s/(?=[?*])/./g;
if( s/\{/(?:/g ) {
tr/,}/|)/ or die "makeppinfo: error: -k, --keylist contained '{', but no ',' or '}'\n";
} else {
/,/ and die "makeppinfo: error: -k, --keylist contained ',', but no '{...}'\n";
}
}
my( %seen, $no_warn, $cwd );
while( @ARGV ) {
my $finfo = shift;
if( ref $finfo ) {
$no_warn = 1;
undef $traverse if $traverse && $traverse == 1;
} else {
$finfo = file_info $finfo;
}
next if exists $seen{int $finfo};
undef $seen{int $finfo};
unless( file_exists $finfo ) {
warn 'makeppinfo: file `' . relative_filename( $finfo ) . "' not found\n";
next;
}
my $build_info_fname = FileInfo::build_info_fname $finfo;
my $fh;
unless( open $fh, $build_info_fname ) {
warn "makeppinfo: build info file `$build_info_fname' not found\n"
unless $no_warn;
next;
}
my $build_info = FileInfo::parse_build_info_file $fh;
unless( $build_info ) {
warn "makeppinfo: build info file `$build_info_fname' corrupted\n";
next;
}
$cwd = file_info $build_info->{CWD}, exists $finfo->{DIRCONTENTS} ? $finfo : $finfo->{'..'}
if $traverse && exists $build_info->{CWD};
if( $build_info->{DEP_SIGS} && $build_info->{SORTED_DEPS} ) {
my @dep_sigs = split /\cA/, delete $build_info->{DEP_SIGS};
my @sorted_deps = split /\cA/, $build_info->{SORTED_DEPS};
push @ARGV, map file_info( $_, $cwd ), @sorted_deps
if $traverse;
$build_info->{SORTED_DEPS} = '';
$build_info->{SORTED_DEPS} .= sprintf "\n%-22s %s", shift @dep_sigs, shift @sorted_deps
while @dep_sigs;
}
if( $keylist ) {
my %want;
for my $re ( split ' ', $keylist ) {
if( $re =~ s/^[!^]// ) {
@want{keys %$build_info} = () if !%want;
delete @want{grep /^$re$/, keys %want};
} else {
@want{grep /^$re$/, keys %$build_info} = ();
}
}
delete @{$build_info}{grep !exists $want{$_}, keys %$build_info};
}
print relative_filename( $finfo ) . ":\n" unless $quiet;
for my $key ( sort keys %$build_info ) {
# Check names explicitly, because there may be no ^B, making it look like a 1 level list:
if( $key =~ /^(?:IMPLICIT_DEPS|INCLUDE_(?:PATHS|SFXS)|META_DEPS)$/ || $build_info->{$key} =~ /\cB/ ) {
my @lists = split /\cB/, $build_info->{$key};
$build_info->{$key} = '';
for( @lists ) {
my( $tag, @sublist ) = split /\cA/, $_;
$build_info->{$key} .= "\n\t$tag\t$_" for @sublist;
}
} elsif( $build_info->{$key} =~ /\cA/ ) {
my @list = split /\cA/, $build_info->{$key};
$build_info->{$key} = '';
$build_info->{$key} .= "\n\t$_" for @list;
} else {
$build_info->{$key} =~ s/\n/\n\t/g;
}
if( $quiet ) {
$build_info->{$key} =~ s/\A\n//;
print "$build_info->{$key}\n";
} else {
print "$key=$build_info->{$key}\n";
}
}
}
sub usage {
print << 'END_OF_USAGE';
Usage: makeppinfo [file ...]
For each file print a human readable version of makepp's build info.
SORTED_DEPS has the DEP_SIGS prepended. Tagged lists have the tag
prepended.
-k LIST, --keys=LIST or --keylist=LIST
Show only messages with, !without or ^without keys, {bash,patterns}.
-q, --quiet
Don't list file and key names. Repeat to also omit warnings.
-t, --traverse
Also output SORTED_DEPS (recursively if repeated).
--version
Print out the current version.
END_OF_USAGE
exit 0;
}