#!/usr/bin/perl -w
#
# unpar - extract files from a Perl archive
#
# mail tgy@chocobo.org < bug_reports
#
# Copyright (c) 1999 Moogle Stuffy Software.  All rights reserved.
# You may play with this software in accordance with the Perl Artistic License.

my $VERSION = '0.02';

my %opts;
while (@ARGV && $ARGV[0] =~ s/^-//) {
    local $_ = shift;
    while (/([cdfqv])/g) {
        if ($1 eq 'd') {
            $opts{'d'} = /\G(.*)/g && $1 ? $1 : shift;
        } else {
            $opts{$1}++;
        }
    }
}

@ARGV = '-' unless @ARGV;

if ($opts{'v'}) {
    print "unpar $VERSION\n";
    exit;
}

my @files = map {
    local *F;
    open F, "< $_" or die "Couldn't open '$_': $!";
    *F;
} @ARGV;

if ($opts{'d'}) {
    chdir $opts{'d'} or die "Couldn't chdir '$opts{'d'}': $!";
}

local $SIG{__WARN__} = sub {} if $opts{'q'};

my $switch = $opts{'c'} || $opts{'f'} ? '-c' : '';

$/ = "\n__END__\n";

for my $file (@files) {
    while (<$file>) {
        s%.*^#!/usr/bin/perl$%%sm or next;
        local $ARGV[0] = $switch;
        eval;
        $@ and die $@;
    }
}

__END__

=head1 NAME

unpar - extract files from a Perl archive

=head1 SYNOPSIS

B<unpar> [-d dir] [-cfqv] file [files...]

=head1 DESCRIPTION

B<unpar> scans I<files> for Perl archives and extracts the files contained in
those archives.

=head1 OPTIONS

=over

=item -c

Overwrite existing files.

=item -d dir

Change directory to I<dir> before extracting files.

=item -f

Same as B<-c>.

=item -q

Shhh!

=item -v

Print version info and exit.

=back

=head1 SEE ALSO

B<par>

=head1 AUTHOR

Tim Gim Yee | tgy@chocobo.org | I want a moogle stuffy!

=head1 COPYRIGHT

Copyright (c) 1999 Moogle Stuffy Software.  All rights reserved.

You may play with this software in accordance with the Perl Artistic License.

=cut