view release on metacpan or  search on metacpan

share/bundle.pl  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;

use FindBin qw($Bin);

use IO::Dir;
use IO::File;
use MIME::Base64  qw(encode_base64);
use File::Spec::Functions qw(catfile no_upwards rel2abs splitdir updir);

#----------------------------------------------------------------------
# Configuration

# Prefix that preceds every command in data section
# Must agree with Initialize.pm
use constant CMD_PREFIX => '#>>>';

# The name of the index file in the template
my $index_file = 'index.html';

# The location of the initialization module relative to this file
my $output = '../lib/App/Followme/Initialize.pm';

#----------------------------------------------------------------------
# Main routine

my $dir = shift(@ARGV) or die "Must supply site directory\n";

chdir ($Bin);
$dir  = rel2abs($dir);
my $out = copy_script($output);

chdir($dir);

my $visitor = get_visitor();
while (my $file = &$visitor) {
    bundle_file($out, $file);
}

close($out);

chdir($Bin);
rename("$output.TMP", $output);

#----------------------------------------------------------------------
# Append a binary file to the bundle

sub append_binary_file {
    my ($out, $file) = @_;


    my $in = IO::File->new($file, 'r');
    die "Couldn't read $file: $!\n" unless $in;

    binmode $in;
    my $buf;

    while (read($in, $buf, 60*57)) {
        print $out encode_base64($buf);
    }

    close($in);
    return;
}

#----------------------------------------------------------------------
# Append a text file to the bundle

sub append_text_file {
    my ($out, $file) = @_;

    my $in = IO::File->new($file, 'r');
    die "Couldn't read $file: $!\n" unless $in;

    while (defined (my $line = <$in>)) {
        chomp($line);
        print $out $line, "\n";
    }

    close($in);
    return;
}

#----------------------------------------------------------------------
# Append a file to the bundle

sub bundle_file {
    my ($out, $file) = @_;

    my $type = -B $file ? 'binary' : 'text';
    my $cmd = join(' ', CMD_PREFIX, 'copy', $type, $file);

    print $out $cmd, "\n";
    if ($type eq 'binary') {
        append_binary_file($out, $file);
    } else {
        append_text_file($out, $file);
    }

    return;
}

#----------------------------------------------------------------------
# Copy the script to start

sub copy_script {
    my ($output) = @_;

    my @path = split(/\//, $output);
    $output = catfile(@path);

    my $last = "__DATA__\n";
    my $in = IO::File->new($output, 'r') or
        die "Couldn't read $output: $!\n";