File Coverage

blib/lib/goto/file.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	15	16	93.7
condition			n/a
subroutine	5	5	100.0
pod	0	1	0.0
total	68	70	97.1

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

our $VERSION = '0.004';

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

our %HANDLES;

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

    return unless $in;

    my ($pkg, $file, $line) = caller(0);
    my ($fh, @lines);

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

        push @lines => "#line " . (__LINE__ + 1) . ' "' . __FILE__ . '"';
        push @lines => (
            "package main;",
            "#line 1 \"lines from $safe line $line\"",
            @$in,
        );
    }
    else {
        push @lines => "#line " . (__LINE__ + 1) . ' "' . __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, file => $in, caller => [$pkg, $file, $line]},
        $class
    );
}

sub filter {
    my $self = shift;

    unless ($self->{init}) {
        $self->{init} = 1;
        while (1) { filter_read() or last }
        $_ = '';
    }

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

    my $line;
    if (@$lines) {
        chomp($line = shift @$lines);
        $line .= "\n";
    }
    elsif ($fh) {
        $line = <$fh>;
    }

    if (defined $line) {
        $_ .= $line;
        return 1;
    }

    return 0;
}

1;

__END__