File wizard_inspect of Package obs-wizard

#!/usr/bin/perl

use strict;
use warnings;

use POSIX qw(nice);
use Data::Dumper;

die "Usage: $0 tarball\n" unless @ARGV == 1;

# entries in the toplevel path, that is the name of the toplevel directory
# in most tarballs
my %toplevel;

# Flags indicating presence of certain  files in the toplevel directory. Since
# we don't know in advance whether the tarball has a toplevel directory, we
# collect flags for the zeroth level too.
my @fileflags = ({}, {});
my %fname2flag = (
	'makefile.am'    => 'has_makefile_am',
	'makefile.in'    => 'has_makefile_in',
	'makefile'       => 'has_makefile',
	'gnumakefile'    => 'has_makefile',
	'configure.ac'   => 'has_configure_ac',
	'configure.in'   => 'has_configure_ac',
	'configure'      => 'has_configure',
	'makefile.pl'    => 'has_makefile_pl',
	'setup.py'       => 'has_setup_py',
	'build.xml'      => 'has_build_xml',
	'cmakelists.txt' => 'has_cmakelists_txt',
);

my %flags;

nice(19);
open(TAR, '-|', "tar", "tf", $ARGV[0]) or die "Error running tar: $!\n";
while (<TAR>) {
	chomp;
	my @path = split(/\//);
	$toplevel{$path[0]} = 1;
	for my $i (0, 1) {
		next if $i >= @path;
		my $file = lc $path[$i];
		my $ff = $fileflags[$i];
		if (exists $fname2flag{$file}) {
			$ff->{$fname2flag{$file}} = 1;
		}
	}
	my $file = $path[$#path];
	if ($file =~ /\.(C|cc|cpp|cxx)$/) {
		$flags{'has_cpp_source'} = 1;
	} elsif ($file =~ /\.(l|ll)$/) {
		$flags{'has_lex_source'} = 1;
		$flags{'has_cpp_source'} = 1 if $1 eq 'll';
	} elsif ($file =~ /\.(y|yy)$/) {
		$flags{'has_yacc_cource'} = 1;
		$flags{'has_cpp_source'} = 1 if $1 eq 'yy';
	} elsif ($file =~ /\.po$/) {
		$flags{'has_po_files'} = 1;
	}
}
close(TAR);
die "tar exited with status @{[$? >> 8]}\n" if $? != 0;

if (keys %toplevel  == 1) {
	@flags{keys %{$fileflags[1]}} = values %{$fileflags[1]};
	$flags{'has_toplevel_dir'} = 1;
	$flags{'toplevel_dir'} = (keys(%toplevel))[0];
} else {
	@flags{keys %{$fileflags[0]}} = values %{$fileflags[0]};
}

# XXX: don't do it manually
print "<result>\n";
foreach my $f (sort keys %flags) {
	my $v = $flags{$f};
	$v =~ s/&/&amp;/sg;
	$v =~ s/</&lt;/sg;
	$v =~ s/>/&gt;/sg;
	$v =~ s/"/&quot;/sg;
	print "  <data name=\"$f\">$v</data>\n";
}
print "</result>\n";