view release on metacpan or  search on metacpan

lib/App/FatPacker/Simple.pm  view on Meta::CPAN

            }
        }
    }
    $self;
}

sub show_help ($self) {
    open my $fh, '>', \my $out;
    Pod::Usage::pod2usage
        exitval => 'noexit',
        input => $0,
        output => $fh,
        sections => 'SYNOPSIS|COMMANDS|OPTIONS|EXAMPLES',
        verbose => 99,
    ;
    $out =~ s/^[ ]{4,6}/  /mg;
    $out =~ s/\n$//;
    print $out;
}

sub warning ($self, $msg) {
    chomp $msg;
    my $color = $self->{color}
              ? sub ($text) { "\e[31m$text\e[m", "\n" }
              : sub ($text) { "$text\n" };
    if ($self->{strict}) {
        die $color->("=> ERROR $msg");
    } elsif (!$self->{quiet}) {
        warn $color->("=> WARN $msg");
    }
}

sub debug ($self, $msg) {
    chomp $msg;
    if (!$self->{quiet}) {
        warn "-> $msg\n";
    }
}

sub output_filename ($self) {
    return $self->{output} if $self->{output};

    my $script = File::Basename::basename $self->{script};
    my ($suffix, @other) = reverse split /\./, $script;
    if (!@other) {
        "$script.fatpack";
    } else {
        unshift @other, "fatpack";
        join ".", reverse(@other), $suffix;
    }
}

sub run ($self) {
    my $fatpacked = $self->fatpack_file($self->{script});
    my $output_filename = $self->output_filename;
    open my $fh, ">", $output_filename
        or die "Cannot open '$output_filename': $!\n";
    print {$fh} $fatpacked;
    close $fh;
    my $mode = (stat $self->{script})[2];
    chmod $mode, $output_filename;
    $self->debug("Successfully created $output_filename");
}

# In order not to depend on App::FatPacker internals,
# we use only App::FatPacker::fatpack_code method.
sub fatpack_file ($self, $file) {
    my ($shebang, $script) = $self->load_main_script($file);
    $shebang = $self->{custom_shebang} if $self->{custom_shebang};
    my %files;
    $self->collect_files($_, \%files) for $self->{dir}->@*;
    my $fatpacker = App::FatPacker->new;
    return join "\n", $shebang, $fatpacker->fatpack_code(\%files), $script;
}

# almost copy from App::FatPacker::load_main_script
sub load_main_script ($self, $file) {
    open my $fh, "<", $file or die "Cannot open '$file': $!\n";
    my @lines = <$fh>;
    my @shebang;
    if (@lines && index($lines[0], '#!') == 0) {
        while (1) {
            push @shebang, shift @lines;
            last if $shebang[-1] =~ m{^\#\!.*perl};
        }
    }
    ((join "", @shebang), (join "", @lines));
}

sub load_file ($self, $absolute, $relative, $original) {

    my $content = do {
        open my $fh, "<", $absolute or die "Cannot open '$absolute': $!\n";
        local $/; <$fh>;
    };

    if ($self->{perl_strip} and !grep { $original =~ $_ } $self->{exclude_strip}->@*) {
        $self->debug("fatpack $relative (with perl-strip)");
        return $self->{perl_strip}->strip($content);
    } else {
        $self->debug("fatpack $relative (without perl-strip)");
        return $content;
    }
}

sub collect_files ($self, $dir, $files) {

    my $absolute_dir = Cwd::abs_path($dir);
    # When $dir is not an archlib,
    # and we are about to search $dir/archlib, skip it!
    # because $dir/archlib itself will be searched another time.
    my $skip_dir = File::Spec->catdir($absolute_dir, $Config{archname});
    $skip_dir = qr/\Q$skip_dir\E/;

    my $find = sub (@) {
        return unless -f $_;
        for my $ignore ($IGNORE_FILE->@*) {
            $_ =~ $ignore and return;
        }
        my $original = $_;
        my $absolute = Cwd::abs_path($original);