Skip to content

Commit

Permalink
Github issue #5 - _coderef() should properly detect non-coderefs
Browse files Browse the repository at this point in the history
  • Loading branch information
@jmaslak
jmaslak committed Jul 14, 2018
1 parent 877f6a4 commit a811c1d
Show file tree
Hide file tree
Showing 3 changed files with 91 additions and 28 deletions.
3 changes: 3 additions & 0 deletions Changes
View file
@@ -1,4 +1,7 @@
{{$NEXT}}
Joelle Maslak <jmaslak@antelope.net>
* TRIAL/DEV RELEASE ONLY
* Bugfix: Github Issue #5 - Don't allow non-coderef as header_handler

1.181861 2018-07-05 07:42:19-06:00 America/Denver
Joelle Maslak <jmaslak@antelope.net>
Expand Down
56 changes: 28 additions & 28 deletions lib/File/ByLine/Object.pm
View file
Expand Up @@ -17,7 +17,7 @@ use autodie;

use Carp;
use Fcntl;
use Scalar::Util qw(reftype);
use Scalar::Util qw(blessed reftype);

# We do this intentionally:
## no critic (Subroutines::ProhibitBuiltinHomonyms)
Expand Down Expand Up @@ -72,15 +72,15 @@ sub processes {
#
# Attribute Accessor - header_handler
#
# This is the code that handles the headder line
# This is the code that handles the header line
sub header_handler {
my ($self) = shift;
if ( scalar(@_) == 0 ) {
return $self->{header_handler};
} elsif ( scalar(@_) == 1 ) {
my $code = shift;
if ( defined( $_[0] ) ) {
if ( !_codelike( $code ) ) {
if ( defined($code) ) {
if ( !_codelike($code) ) {
confess("header_handler must be a code reference");
}
if ( $self->{header_skip} ) {
Expand Down Expand Up @@ -133,11 +133,11 @@ sub new {
# Executes the provided code on every line.
#
sub do {
if (scalar(@_) < 2) { confess "Invalid call"; }
if ( scalar(@_) < 2 ) { confess "Invalid call"; }
my ( $self, $code, $file ) = @_;

if (!defined($file)) { $file = $self->{file} };
if (!defined($file)) { confess "Must provide filename"; }
if ( !defined($file) ) { $file = $self->{file} }
if ( !defined($file) ) { confess "Must provide filename"; }

if ( defined( $self->{header_handler} ) ) {
my $header = $_ = $self->_read_header($file);
Expand Down Expand Up @@ -168,11 +168,11 @@ sub do {
#
# Finds and returns matching lines
sub grep {
if (scalar(@_) < 2) { confess "Invalid call"; }
if ( scalar(@_) < 2 ) { confess "Invalid call"; }
my ( $self, $code, $file ) = @_;

if (!defined($file)) { $file = $self->{file} };
if (!defined($file)) { confess "Must provide filename"; }
if ( !defined($file) ) { $file = $self->{file} }
if ( !defined($file) ) { confess "Must provide filename"; }

if ( defined( $self->{header_handler} ) ) {
my $header = $_ = $self->_read_header($file);
Expand All @@ -183,7 +183,7 @@ sub grep {

my $procs = $self->{processes};

if ($procs > 1) {
if ( $procs > 1 ) {
my $wu = Parallel::WorkUnit->new();

$wu->asyncs( $procs, sub { return $self->_grep_chunk( $code, $file, $procs, $_[0] ); } );
Expand All @@ -201,11 +201,11 @@ sub grep {
#
# Applies function to each entry and returns that result
sub map {
if (scalar(@_) < 2) { confess "Invalid call"; }
if ( scalar(@_) < 2 ) { confess "Invalid call"; }
my ( $self, $code, $file ) = @_;

if (!defined($file)) { $file = $self->{file} };
if (!defined($file)) { confess "Must provide filename"; }
if ( !defined($file) ) { $file = $self->{file} }
if ( !defined($file) ) { confess "Must provide filename"; }

if ( defined( $self->{header_handler} ) ) {
my $header = $_ = $self->_read_header($file);
Expand All @@ -216,7 +216,7 @@ sub map {

my $procs = $self->{processes};

if ($procs > 1) {
if ( $procs > 1 ) {
my $wu = Parallel::WorkUnit->new();

$wu->asyncs( $procs, sub { return $self->_map_chunk( $code, $file, $procs, $_[0] ); } );
Expand All @@ -234,11 +234,11 @@ sub map {
#
# Returns all lines in the file
sub lines {
if (scalar(@_) < 1) { confess "Invalid call"; }
my ($self, $file) = @_;
if ( scalar(@_) < 1 ) { confess "Invalid call"; }
my ( $self, $file ) = @_;

if (!defined($file)) { $file = $self->{file} };
if (!defined($file)) { confess "Must provide filename"; }
if ( !defined($file) ) { $file = $self->{file} }
if ( !defined($file) ) { confess "Must provide filename"; }

my @lines;

Expand All @@ -249,9 +249,9 @@ sub lines {
$lineno++;
chomp;

if ( ($lineno == 1) && defined( $self->{header_handler} ) ) {
if ( ( $lineno == 1 ) && defined( $self->{header_handler} ) ) {
$self->{header_handler}($_);
} elsif ( ($lineno == 1) && $self->{header_skip} ) {
} elsif ( ( $lineno == 1 ) && $self->{header_skip} ) {
# Do nothing;
} else {
push @lines, $_;
Expand All @@ -265,7 +265,7 @@ sub lines {

# Internal function to read header line
sub _read_header {
my ($self, $file) = @_;
my ( $self, $file ) = @_;

my ( $fh, undef ) = _open_and_seek( $file, 1, 0 );
my $line = <$fh>;
Expand Down Expand Up @@ -331,9 +331,9 @@ sub _grep_chunk {

chomp;

if ( (!$part) && ( $lineno == 1 ) && ( defined( $self->{header_handler} ) ) ) {
if ( ( !$part ) && ( $lineno == 1 ) && ( defined( $self->{header_handler} ) ) ) {
$self->{header_handler}($_);
} elsif ( (!$part) && ( $lineno == 1 ) && ( $self->{header_skip} ) ) {
} elsif ( ( !$part ) && ( $lineno == 1 ) && ( $self->{header_skip} ) ) {
# Do nothing, we're skipping the header.
} else {
if ( $code->($_) ) {
Expand Down Expand Up @@ -368,9 +368,9 @@ sub _map_chunk {

chomp;

if ( (!$part) && ( $lineno == 1 ) && ( defined( $self->{header_handler} ) ) ) {
if ( ( !$part ) && ( $lineno == 1 ) && ( defined( $self->{header_handler} ) ) ) {
$self->{header_handler}($_);
} elsif ( (!$part) && ( $lineno == 1 ) && ( $self->{header_skip} ) ) {
} elsif ( ( !$part ) && ( $lineno == 1 ) && ( $self->{header_skip} ) ) {
# Do nothing, we're skipping the header.
} else {
push @mapped_lines, $code->($_);
Expand Down Expand Up @@ -495,8 +495,8 @@ sub _codelike {
if ( scalar(@_) != 1 ) { confess 'invalid call' }
my $thing = shift;

if ( reftype($thing) ) { return 1; }
if ( blessed($thing) & overload::Method( $thing, '()' ) ) { return 1; }
if ( defined( reftype($thing) ) && ( reftype($thing) eq 'CODE' ) ) { return 1; }
if ( blessed($thing) && overload::Method( $thing, '&{}' ) ) { return 1; }

return;
}
Expand Down
60 changes: 60 additions & 0 deletions t/20-github-0005.t
View file
@@ -0,0 +1,60 @@
#!/usr/bin/perl

#
# Copyright (C) 2018 Joelle Maslak
# All Rights Reserved - See License
#

use strict;
use warnings;
use autodie;

use v5.10;

use Carp;

use Test2::V0;

use File::ByLine;

package overloadcode {
use overload '&{}' => \&mysub;

sub new {
my $self = {};
bless $self;
return $self;
}

sub mysub {
return sub { return 1 };
}
};

package overloadarray {
use overload '@{}' => \&myarr;

sub new {
my $self = {};
bless $self;
return $self;
}

sub myarr {
return [];
}
};

my $arraylike = overloadarray->new();
my $codelike = overloadcode->new();

my $byline = File::ByLine->new();

ok dies { $byline->header_handler("not code") }, "String dies";
ok dies { $byline->header_handler( [] ) }, "Arrayref dies";

ok lives { $byline->header_handler($codelike) }, "Overloaded coderef lives";
ok dies { $byline->header_handler($arraylike) }, "Overloaded arrayref dies";

done_testing();

0 comments on commit a811c1d

Please sign in to comment.