view release on metacpan or  search on metacpan

bin/par  view on Meta::CPAN

=end metadata

=cut


#
# par - create a Perl archive of files
#

my $VERSION = '0.08';

use File::Find;
use File::Basename;
use Getopt::Std qw(getopts);
use Cwd;

eval 'use Stat::lsMode';
my $stat_lsmode = not $@;

use strict;
use vars qw/$size $mode $name/;

$|++;
binmode STDIN;
binmode STDOUT;

# Are we 'par' or 'shar'?
($0) = $0 =~ /(\w+)$/;

sub usage {
    die "usage: $0 [-s submitter] [-STBqvz] file...\n";
}

my %opts;
getopts('s:STBqvz', \%opts) or usage();
@ARGV or usage();

# Print version.
if ($opts{'v'}) {
    print "$0 $VERSION\n";
    exit;
}

# Want shar output.
$0 = 'shar' if $opts{'z'};

# Read STDIN for filenames.
if ($opts{'S'}) {
    chomp(my @files = <STDIN>);
    push @ARGV, @files;
}

# Work quietly.
local $SIG{__WARN__} = sub {} if $opts{'q'};

# Header info.
my $date = localtime;
my $cwd  = cwd;
my $user = $opts{'s'} || do {
    require Sys::Hostname;
    (getlogin || getpwuid($<) || $ENV{USER} || $ENV{LOGNAME} || 'nobody')
    . '@'
    . Sys::Hostname::hostname();
};

# Header.
print $0 eq 'shar' ? <<INTRO_SHAR : <<INTRO_PAR;
#!/bin/sh
# This is a shell archive (produced by par $VERSION).
# To extract the files from this archive, save it to some FILE, remove
# everything before the '#!/bin/sh' line above, then type 'sh FILE'.
INTRO_SHAR
#!/usr/bin/perl
# This is a Perl archive (produced by par $VERSION).
# To extract the files from this archive, save it to some FILE, remove
# everything before the '#!/usr/bin/perl' line above, then type 'perl FILE'.
INTRO_PAR

# More header.
print <<INTRO;
#
# Made on $date by <$user>.
# Source directory was '$cwd'.
#
# Existing files will *not* be overwritten unless '-c' is specified.
#
# This $0 contains:
# length mode       name
# ------ ---------- ------------------------------------------
INTRO

# Format for index of files.
format INDEX =
@ @>>>>> @>>>>>>>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'#', $size, $mode, $name
.

# Store file stats here.
my %index;

# Stat files and directories, and print out an index.
find sub {
    $name = $File::Find::name;
    my %stat;
    @stat{'mode', 'size', 'atime', 'mtime'} = (stat)[2,7,8,9];
    ($mode, $size) = @stat{'mode', 'size'};
    my $oct = (join '' => 0, ($mode&0700)>>6, ($mode&0070)>>3, ($mode&0007));
    $mode = $stat_lsmode ? format_mode($mode) : $oct;
    $stat{mode} = $oct;
    if ($0 eq 'shar') {
        for ('atime', 'mtime') {
            my ($sec,$min,$hour,$mday,$mon,$year) = localtime $stat{$_};
            $stat{$_} = sprintf '%02d%02d%02d%02d.%02d',
                $mon + 1, $mday, $hour, $min, $sec;
        }
    }
    $index{$name} = \%stat;
    local $~ = 'INDEX';
    write;
}, @ARGV;