File Coverage

blib/lib/File/Edit/Portable.pm

Criterion	Covered	Total	%
statement	233	233	100.0
branch	88	102	86.2
condition	25	27	92.5
subroutine	27	27	100.0
pod	8	8	100.0
total	381	397	95.9

package File::Edit::Portable;
use 5.008;
use strict;
use warnings;

local $SIG{__WARN__} = sub { confess(shift); };
our $VERSION = '1.26';

use Carp qw(confess croak);
use Exporter;
use Fcntl qw(:flock);
use File::Find::Rule;
use File::Temp;
use POSIX qw(uname);

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
    recsep
    platform_recsep
);

sub new {
    return bless {}, shift;
}
sub read {
    my $self = shift;
    my ($file, $testing);

    if ($_[0] eq 'file'){
        $self->_config(@_);
    }
    else {
        $file = shift;
        $testing = shift if @_;
        $self->_config(file => $file, testing => $testing);
    }

    $file = $self->{file};
    $testing = $self->{testing};

    if (! $file){
        confess "read() requires a file name sent in!";
    }

    $self->recsep($file);
    $self->{files}{$file}{is_read} = 1;
    $self->{files}{$file}{recsep} = $self->{recsep};
    $self->{reads}{count} = keys %{ $self->{files} };

    my $fh;

    if (! wantarray){
        $fh = $self->_handle($file);
        return $fh;
    }
    else {
        $fh = $self->_binmode_handle($file);
        my @contents = <$fh>;
        close $fh or confess "read() can't close file $file!: $!";

        if (! $testing){
            for (@contents){
                $_ = $self->_strip_ends($_);
            }
        }
        return @contents;
    }
}
sub write {
    my $self = shift;
    my %p = @_;
    $self->_config(%p);

    if (! $self->{file}){
        confess "write() requires a file to be passed in!";
    }

    my $reads_count = $self->{reads}{count} || 0;

    if ($reads_count > 1 && ! $p{file}){
        confess "\nif calling write() with more than one read() open, you must " .
                "send in a file name with the 'file' parameter so we know " .
                "which file to write. You currently have the following files " .
                "open: " . join(' ', keys %{ $self->{files} }) . "\n";
    }
    if (! $self->{contents}){
        confess "write() requires 'contents' param sent in";
    }

    my $file = $self->{file}; # needed for cleanup of open file list

    if (! $self->{files}{$file}{is_read}){
        $self->{files}{$file}{recsep} = $self->recsep($file);
    }

    $self->{file} = $self->{copy} if $self->{copy};

    my $wfh = $self->_binmode_handle($self->{file}, 'w');

    # certain FreeBSD versions on amd64 don't work
    # with flock()

    my @os = uname();

    unless ($os[0] eq 'FreeBSD' && $os[-1] eq 'amd64'){
        flock $wfh, LOCK_EX;
    }

    my $recsep = defined $self->{custom_recsep}
        ? $self->{custom_recsep}
        : $self->{files}{$file}{recsep};

    my $contents = $self->{contents};

    if (ref($contents) eq 'GLOB' || ref($contents) eq 'File::Temp') {
        {
            my $warn;
            local $SIG{__WARN__} = sub { $warn = shift; };

            seek $contents, 0, 0;

            if ($warn) {
                confess "\nthe file handle you're passing into write() as ".
                    "the contents param has already been closed\n";
            }
        };

        while (<$contents>){
            $_ = $self->_strip_ends($_);
            print $wfh $_ . $recsep;
        }
        close $contents;
    }
    else {
        for (@$contents){
            $_ = $self->_strip_ends($_);
            print $wfh $_ . $recsep;
        }
    }

    close $wfh;
    delete $self->{files}{$file}; # cleanup open list
    $self->{reads}{count} = 0 if keys %{ $self->{files} } == 0;

    return 1;
}
sub splice {
    my $self = shift;
    $self->_config(@_);

    my $file = $self->{file};
    my $copy = $self->{copy};
    my $insert = $self->{insert};
    my $limit = defined $self->{limit} ? $self->{limit} : 1;

    if (! $insert){
        confess "splice() requires insert => [aref] param";
    }

    my ($line, $find) = ($self->{line}, $self->{find});

    if (! defined $line && ! defined $find){
        confess
          "splice() requires either the 'line' or 'find' parameter sent in.";
    }

    if (defined $line && defined $find){
        warn
          "splice() can't search for both line and find. Operating on 'line'.";
    }

    my @contents = $self->read($file);

    if (defined $line){
        if ($line !~ /^[0-9]+$/){
            confess "splice() requires its 'line' param to contain only an " .
                  "integer. You supplied: $line\n";
        }
        splice @contents, $line, 0, @$insert;
    }

    if (defined $find && ! defined $line){
        $find = qr{$find} if ! ref $find ne 'Regexp';

        my $i = 0;
        my $inserts = 0;

        for (@contents){
            $i++;
            if (/$find/){
                $inserts++;
                splice @contents, $i, 0, @$insert;
                if ($limit){
                    last if $inserts == $limit;
                }
            }
        }
    }

    $self->write(contents => \@contents, copy => $copy);

    return @contents;
}
sub dir {
    my $self = shift;
    $self->_config(@_);

    my $recsep = $self->{custom_recsep};

    my @types;

    if ($self->{types}){
        @types = @{ $self->{types} };
    }
    else {
        @types = qw(*);
    }

    my $find = File::Find::Rule->new;

    $find->maxdepth($self->{maxdepth}) if $self->{maxdepth};
    $find->file;
    $find->name(@types);

    my @files = $find->in($self->{dir});

    return @files if $self->{list};

    for my $file (@files){

        my $fh = $self->read($file);
        my $wfh = $self->tempfile;

        while(<$fh>){
            print $wfh $_;
        }
        close $fh;

        $self->write(
            file => $file,
            contents => $wfh,
            recsep => defined $recsep
                ? $recsep
                : $self->platform_recsep,
        );
    }

    return @files;
}
sub recsep {
    my $self = ref $_[0] eq __PACKAGE__
        ? shift
        : __PACKAGE__->new;

    my $file = shift;
    my $want = shift;

    my $fh;
    eval {
        $fh = $self->_binmode_handle($file);
    };

    if ($@ || -z $fh){

        # we've got an empty file...
        # we'll set recsep to the local platform's

        $self->{recsep} = $self->platform_recsep;

        return $want
            ? $self->_convert_recsep($self->{recsep}, $want)
            : $self->{recsep};
    }

    seek $fh, 0, 0;

    my $recsep_regex = $self->_recsep_regex;

    if (<$fh> =~ /$recsep_regex/){
        $self->{recsep} = $1;
    }

    close $fh or confess "recsep() can't close file $file!: $!";

    return $want
        ? $self->_convert_recsep($self->{recsep}, $want)
        : $self->{recsep};
}
sub platform_recsep {
    my $self = ref $_[0] eq __PACKAGE__
        ? shift
        : __PACKAGE__->new;

    my $want = shift;

    # for platform_recsep(), we need the file open in ASCII mode,
    # so we can't use _binmode_handle() or File::Temp

    my $file = $self->_temp_filename;

    open my $wfh, '>', $file
      or confess
        "platform_recsep() can't open temp file $file for writing!: $!";

    print $wfh "abc\n";

    close $wfh
      or confess "platform_recsep() can't close write temp file $file: $!";

    my $fh = $self->_binmode_handle($file);

    my $recsep_regex = $self->_recsep_regex;

    if (<$fh> =~ /$recsep_regex/){
        $self->{platform_recsep} = $1;
    }

    close $fh
      or confess "platform_recsep() can't close temp file $file after run: $!";

    unlink $file or confess "Can't unlink temp file '$file': $!";

    return $want
        ? $self->_convert_recsep($self->{platform_recsep}, $want)
        : $self->{platform_recsep};
}
sub tempfile {
    # returns a temporary file handle in write mode

    my $wfh = File::Temp->new(UNLINK => 1);
    return $wfh;
}
sub _config {
    # configures self with incoming params

    my $self = shift;
    my %p = @_;

    $self->{custom_recsep} = $p{recsep};
    delete $p{recsep};

    my @params = qw(
                    testing copy types list maxdepth
                    insert line find limit
                   );

    for (@params){
        delete $self->{$_};
    }

    for (keys %p){
        $self->{$_} = $p{$_};
    }
}
sub _handle {
    # returns a handle with platform's record separator

    my $self = shift;
    my $file = shift;

    my $fh;

    if ($self->recsep($file, 'hex') ne $self->platform_recsep('hex')){

        $fh = $self->_binmode_handle($file);
        my $temp_wfh = $self->tempfile;
        binmode $temp_wfh, ':raw';

        my $temp_filename = $temp_wfh->filename;

        while (<$fh>){
            $_ = $self->_platform_replace($_);
            print $temp_wfh $_;
        }

        close $fh or confess "can't close file $file: $!";
        close $temp_wfh or confess "can't close file $temp_filename: $!";

        my $ret_fh = $self->_binmode_handle($temp_filename);

        return $ret_fh;
    }
    else {
        $fh = $self->_binmode_handle($file);
        return $fh;
    }
}
sub _binmode_handle {
    # returns a handle opened with binmode :raw

    my $self = shift;
    my $file = shift;
    my $mode = shift || 'r';

    my $fh;

    if ($mode =~ /^w/){
        open $fh, '>', $file
          or confess "_binmode_handle() can't open file $file for writing!: $!";
    }
    else {
        open $fh, '<', $file
          or confess "_binmode_handle() can't open file $file for reading!: $!";
    }

    binmode $fh, ':raw';

    return $fh;
}
sub _convert_recsep {
    # converts recsep to either hex or OS name (ie. type)

    my ($self, $sep, $want) = @_;

    $sep = unpack "H*", $sep;
    $sep =~ s/0/\\0/g;

    return $sep if $want eq 'hex';

    my %seps = (
        '\0a'    => 'nix',
        '\0d\0a' => 'win',
        '\0d'    => 'mac',
    );

    return $seps{$sep} || 'unknown';
}
sub _recsep_regex {
    # returns a regex object representing all recseps
    return qr/([\n\x{0B}\f\r\x{85}]{1,2})/;
}
sub _platform_replace {
    # replace recseps in a string with the platform recsep

    my ($self, $str) = @_;
    my $re = $self->_recsep_regex;
    $str =~ s/$re/$self->platform_recsep/ge;
    return $str;
}
sub _strip_ends {
    # strip all line endings from string

    my ($self, $str) = @_;
    my $re = $self->_recsep_regex;
    $str =~ s/$re//g;
    return $str;
}
sub _temp_filename {
    # return the name of a temporary file

    my $temp_fh = File::Temp->new(UNLINK => 1);
    my $filename = $temp_fh->filename;
    return $filename;
}
sub _vim_placeholder { return 1; }; # for folding

1;
__END__