pkg-components 0.8 / usr / bin / uscan-components

#!/usr/bin/perl 

eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
    if 0; # not running under some shell
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use Readonly;
use Carp;
use DirHandle;
use Perl6::Slurp;
use Debian::Parse::Uscan;

Readonly my %VALUED_ARGS=>(
    useragent=>1,
    timeout=>1,
    destdir=>1,
);
Readonly my $MAIN_WATCH_FILE => 'debian/watch';
Readonly my $COMPONENTS_DIR => 'debian/components';

# This might need reconsideration if we ever support --destdir
Readonly my $DEST_DIR => '..';

my %watch_files;
my %versions;
my $dry_run = 0;
my $help = 0;
my $man = 0;
my $verbose = 0;
my $upgrade = 0;
my %args = (
    'dry-run'   => \$dry_run,
    'help'      => \$help,
    'man'       => \$man,
    'verbose'   => \$verbose,
    'upgrade'   => \$upgrade,
);

GetOptions(\%args,
    'dry-run!',
    'help|?',
    'man',
    'report!',
    'upgrade!',
    'report-status!',
#    'destdir=s',
    'timeout=i',
    'pasv!',
    'pasv!',
    'verbose!',
#    'repack',
#    'rename',
    'debug',
    'useragent|user-agent=s',
) or pod2usage(2);
pod2usage(1) if $help;
pod2usage(-exitstatus => 0, -verbose=>2) if $man;

delete $args{help};
delete $args{man};
delete $args{'dry-run'};
delete $args{verbose};
delete $args{upgrade};

if (not -r $MAIN_WATCH_FILE) {
    croak "Could not read $MAIN_WATCH_FILE";
}
my $dir = DirHandle->new($COMPONENTS_DIR);
if (defined $dir) {
    for(my $file = $dir->read; defined $file; $file = $dir->read) {
        next if $file =~ m{\A\.}xms;
        next if not -d $file;
        $watch_files{$file} = "$COMPONENTS_DIR/$file/watch";
        if (not -r $watch_files{$file}) {
            croak "Could not read $watch_files{$file}";
        }
        my $version_file = "$COMPONENTS_DIR/$file/version";
        if (-r $version_file) {
            $versions{$file} = slurp $version_file;
        }
        else {
            $versions{$file} = undef;
        }
    }
}
else {
    croak "Could not read $COMPONENTS_DIR";
}

my $usage = "uscan --verbose ";
foreach my $arg (keys %args) {
    if ($VALUED_ARGS{$arg}) {
        $usage .= "--$arg=$args{$arg} ";
    }
    elsif ($args{$arg}) {
        $usage .= "--$arg ";
    }
    else {
        $usage .= "--no-$arg ";
    }
}
if (not $upgrade) {
    $usage .= " --force-download";
}

my $uscan_parser = Debian::Parse::Uscan->new;

my $main_uscan = "$usage --watch=$MAIN_WATCH_FILE";
if (not $upgrade) {
    $main_uscan .= " --download-current-version";
}
if (my $main_results = _doit($main_uscan)) {
    my $main_details = $dry_run ? "" : $uscan_parser->parse($main_results);
    foreach my $component (keys %watch_files) {
        my $comp_uscan = $dry_run ? "\t" : "";
        $comp_uscan .= "$usage --watch=$watch_files{$component} --no-symlink";
        if (not $upgrade and defined $versions{$component}) {
            $comp_uscan .= " --download-version=$versions{$component}";
        }
        my $comp_results = _doit($comp_uscan);
        exit(1) if not $comp_results;
        if (not $dry_run) {
            my $comp_details = $uscan_parser->parse($comp_results);
            my $symlink = $main_details->{symlink};
            $symlink =~ s{\.orig\.}{.orig-$component\.}xms;
            my $comp_ln = "";
            if ($comp_results) {
                $comp_ln = "ln -s $DEST_DIR/$comp_details->{downloaded_file} $DEST_DIR/$symlink";
            }
            else {
                my $oldtar = $symlink;
                $oldtar =~ s{\.[^\.]+\.orig-}{\.$main_details->{local_version}\.orig-}xms;
                $comp_ln = "cp $DEST_DIR/$oldtar $DEST_DIR/$symlink";
            }
            exit(1) if not _doit($comp_ln);
            if (open my $fh, ">", "$COMPONENTS_DIR/$component/version") {
                print {$fh} $comp_details->{remote_version};
            }
        }
    }
}

exit(0);

sub _doit {
    my $command = shift;
    if ($dry_run) {
        print "$command\n";
        return 1;
    }
    my $output = `$command`;
    if ($verbose) {
        print $output;
    }
    if ($? == 0) {
        return $output;
    }
    elsif ($? == -1) {
        print "failed to execute: $!\n";
    }
    elsif ($? & 127) {
        my $signal = $? & 127;
        my $preposition = $? & 128 ? 'with' : 'without';
        print "child died with signal $signal, $preposition coredump\n";
    }
    else {
        my $value = $? >> 8;
        print "child exited with value $value\n"
    }
    return;
}

=head1 NAME

uscan-components - wrapper around uscan for package and components

=head1 SYNOPSIS

B<uscan-components> [S<I<options>>]

=head1 DESCRIPTION

C<uscan-components> is a wrapper around C<uscan> for packages using
C<dh_components>. Firstly it will check that both the package and all
the components have watch files; and will return an error if they do not.
Then it will run uscan on the main watch file. If that downloads something
it will run uscan on each of the components. It accepts a number of 
uscan options all of which are passed onto to each invocation of uscan.

=head1 OPTIONS

=over 4

=item B<--upgrade>

=item B<--no-upgrade>

By default the current versions of the various components will be downloaded.
This resolves into B<--force-download> and either B<--download-current-version>
or B<--upstream-version> for the main and component tarballs respectively.
The current versions of the components are stored in the files:
C<debian/components/>I<comp>C</version>.
If the B<--upgrade> option is applied then instead the latest version will
be requested and the version files updated accordingly.

=item B<--dry-run>

If set no actual uscan will not actually be called but those that might be
will be listed.

=item B<--help>

Prints a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=item B<--verbose>

=item B<--no-verbose>

These options simulate the verbosity flag being passed to C<uscan>.
The actual invocations must always be verbose as the information is required
to correctly rename the component files. However the output is not passed back
to the user if verbosity is turned off.

=item B<--report>

=item B<--report-status>

=item B<--pasv>

=item B<--no-pasv>

=item B<--timeout>

=item B<--debug>

=item B<--user-agent>, B<--useragent>

All of the these arguments are passed straight to each uscan invocation.

=back

=head1 FILES

For each component the watch file is assumed to be in
C<debian/components/>I<component>C</watch> and the component
version is maintained in C<debian/components/>I<component>C</version>.

=head1 SEE ALSO

L<uscan(1)>

=head1 AUTHOR

Nicholas Bamber <nicholas@periapt.co.uk>

=cut