The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

=for info

Name: unpar
Description: extract files from a Perl archive
Author: Tim Gim Yee, tim.gim.yee@gmail.com
License: perl

=cut

#
# unpar - extract files from a Perl archive
#

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

This implementation of I<unpar> was written by Tim Gim Yee,
I<tim.gim.yee@gmail.com>.

=head1 COPYRIGHT and LICENSE

This program is copyright (c) Tim Gim Yee 1999.

This program is free and open software. You may use, modify, distribute,
and sell this program (and any modified variants) in any way you wish,
provided you do not restrict others from doing the same.

=cut