File Coverage

blib/lib/goto/file.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	11	12	91.6
condition			n/a
subroutine	5	5	100.0
pod	0	1	0.0
total	59	61	96.7

package goto::file;
use strict;
use warnings;

our $VERSION = '0.003';

use Filter::Util::Call qw/filter_add/;

our %HANDLES;

my $ID = 1;
sub import {
    my $class = shift;
    my ($in) = @_;

    return unless $in;

    my ($fh, @lines);

    if (ref($in) eq 'ARRAY') {
        my ($pkg, $file, $line) = caller(0);
        my $safe = $file;
        $safe =~ s/"/\\"/;

        @lines = (
            "package $pkg;",
            "#line 1 \"lines from $safe line $line\"",
            @$in,
        );
    }
    else {
        push @lines => "#line " . __LINE__ . ' "' . __FILE__ . '"';
        push @lines => "package main;";
        push @lines => "\$@ = '';";

        my $id = $ID++;

        open($fh, '<', $in) or die "Cold not open file '$in': $!";

        $HANDLES{$id} = $fh;
        my $safe = $in;
        $safe =~ s/"/\\"/;
        push @lines => "#line " . (__LINE__ + 2) . ' "' . __FILE__ . '"';
        push @lines => (
            '{ local ($!, $?, $^E, $@); close(DATA); *DATA = $' . __PACKAGE__ . '::HANDLES{' . $id . '} }',
            qq{#line 1 "$safe"},
        );
    }

    Filter::Util::Call::filter_add(
        bless { fh => $fh, lines => \@lines },
        $class
    );
}

sub filter {
    my $self = shift;

    my $lines = $self->{lines};
    my $fh    = $self->{fh};

    my $line;
    if (@$lines) {
        $line = shift @$lines;
    }
    elsif ($fh) {
        $line = <$fh>;
    }

    if (defined $line) {
        # Normalize to make sure each line ends with a newline.
        # Without this things choke on files with no terminal newline.
        chomp($line);
        $_ .= $line;
        $_ .= "\n";

        return 1;
    }

    return 0;
}

1;

__END__