Safe-Isa-1.000005/000755 000767 000024 00000000000 12373754033 013612 5ustar00etherstaff000000 000000 Safe-Isa-1.000005/Changes000644 000767 000024 00000001054 12373754020 015101 0ustar00etherstaff000000 000000 Revision history for Safe-Isa 1.000005 - 2014-08-16 - comment blessed use so people who don't know perl stop trying to break it - add link to lightning talk given at YAPC::NA 2013 1.000004 - 2013-09-18 - fixed slightly mangled metadata from last release 1.000003 - 2013-03-25 - fix NAME in Makefile.PL (RT#84212) 1.000002 - 2012-07-19 - Document why we don't try and handle class names - Missed another stupid doc typo (thanks MJD) 1.000001 - 2012-07-18 - Fix stupid doc typo (thanks miyagawa) 1.000000 - 2012-07-18 - Initial release Safe-Isa-1.000005/lib/000755 000767 000024 00000000000 12373754033 014360 5ustar00etherstaff000000 000000 Safe-Isa-1.000005/maint/000755 000767 000024 00000000000 12373754033 014722 5ustar00etherstaff000000 000000 Safe-Isa-1.000005/Makefile.PL000644 000767 000024 00000005057 12373753331 015573 0ustar00etherstaff000000 000000 use strict; use warnings FATAL => 'all'; use 5.008001; use ExtUtils::MakeMaker; (do 'maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; my %WriteMakefileArgs = ( NAME => 'Safe::Isa', VERSION_FROM => 'lib/Safe/Isa.pm', META_MERGE => { 'meta-spec' => { version => 2 }, dynamic_config => 0, resources => { # r/w: p5sagit@git.shadowcat.co.uk:Safe-Isa.git repository => { url => 'git://git.shadowcat.co.uk/p5sagit/Safe-Isa.git', web => 'http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/Safe-Isa.git', type => 'git', }, bugtracker => { mailto => 'bug-Safe-Isa@rt.cpan.org', web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Safe-Isa', }, }, }, META_ADD => { prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => '0', }, }, runtime => { requires => { 'Exporter' => '5.57', 'Scalar::Util' => 0, perl => '5.006', }, }, test => { requires => { 'Test::More' => '0', }, }, }, }, realclean => { FILES => [ 'Distar/', 'MANIFEST*' ] }, ); my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; next unless exists $WriteMakefileArgs{META_ADD}{prereqs}{$_} or exists $WriteMakefileArgs{$key}; my $r = $WriteMakefileArgs{$key} = { %{$WriteMakefileArgs{META_ADD}{prereqs}{$_}{requires} || {}}, %{delete $WriteMakefileArgs{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } # dynamic prereqs get added here. $WriteMakefileArgs{MIN_PERL_VERSION} = delete $WriteMakefileArgs{PREREQ_PM}{perl} || 0; die 'attention developer: you need to do a sane meta merge here!' if keys %{$WriteMakefileArgs{BUILD_REQUIRES}}; $WriteMakefileArgs{BUILD_REQUIRES} = { %{$WriteMakefileArgs{BUILD_REQUIRES} || {}}, %{delete $WriteMakefileArgs{TEST_REQUIRES}} } if $eumm_version < 6.63_03; $WriteMakefileArgs{PREREQ_PM} = { %{$WriteMakefileArgs{PREREQ_PM}}, %{delete $WriteMakefileArgs{BUILD_REQUIRES}} } if $eumm_version < 6.55_01; delete $WriteMakefileArgs{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; delete $WriteMakefileArgs{MIN_PERL_VERSION} if $eumm_version < 6.48; delete @WriteMakefileArgs{qw(META_ADD META_MERGE)} if $eumm_version < 6.46; delete $WriteMakefileArgs{LICENSE} if $eumm_version < 6.31; WriteMakefile(%WriteMakefileArgs); Safe-Isa-1.000005/MANIFEST000644 000767 000024 00000000602 12373754033 014741 0ustar00etherstaff000000 000000 Changes lib/Safe/Isa.pm maint/bump-version maint/Makefile.include maint/Makefile.PL.include Makefile.PL MANIFEST This list of files t/safe_isa.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) Safe-Isa-1.000005/META.json000644 000767 000024 00000002555 12373754033 015242 0ustar00etherstaff000000 000000 { "abstract" : "Call isa, can, does and DOES safely on things that may not be objects", "author" : [ "mst - Matt S. Trout (cpan:MSTROUT) " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Safe-Isa", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Exporter" : "5.57", "Scalar::Util" : "0", "perl" : "5.006" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Safe-Isa@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Safe-Isa" }, "repository" : { "type" : "git", "url" : "git://git.shadowcat.co.uk/p5sagit/Safe-Isa.git", "web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit/Safe-Isa.git" } }, "version" : "1.000005" } Safe-Isa-1.000005/META.yml000644 000767 000024 00000001340 12373754033 015061 0ustar00etherstaff000000 000000 --- abstract: 'Call isa, can, does and DOES safely on things that may not be objects' author: - 'mst - Matt S. Trout (cpan:MSTROUT) ' build_requires: Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 6.98, CPAN::Meta::Converter version 2.142060' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Safe-Isa no_index: directory: - t - inc requires: Exporter: '5.57' Scalar::Util: '0' perl: '5.006' resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Safe-Isa repository: git://git.shadowcat.co.uk/p5sagit/Safe-Isa.git version: '1.000005' Safe-Isa-1.000005/README000644 000767 000024 00000007441 12373754033 014500 0ustar00etherstaff000000 000000 NAME Safe::Isa - Call isa, can, does and DOES safely on things that may not be objects SYNOPSIS use strict; use warnings; { package Foo; sub new { bless({}, $_[0]) } } { package Bar; our @ISA = qw(Foo); sub bar { 1 } } my $foo = Foo->new; my $bar = Bar->new; my $blam = [ 42 ]; # basic isa usage - $foo->isa('Foo'); # true $bar->isa('Foo'); # true $blam->isa('Foo'); # BOOM $foo->can('bar'); # false $bar->can('bar'); # true $blam->can('bar'); # BOOM # Safe::Isa usage - use Safe::Isa; $foo->$_isa('Foo'); # true $bar->$_isa('Foo'); # true $blam->$_isa('Foo'); # false, no boom today $foo->$_can('bar'); # false $bar->$_can('bar'); # true $blam->$_can('bar'); # false, no boom today Similarly: $maybe_an_object->$_does('RoleName'); # true or false, no boom today $maybe_an_object->$_DOES('RoleName'); # true or false, no boom today And just in case we missed a method: $maybe_an_object->$_call_if_object(name => @args); Or to re-use a previous example for purposes of explication: $foo->$_call_if_object(isa => 'Foo'); # true $bar->$_call_if_object(isa => 'Foo'); # true $blam->$_call_if_object(isa => 'Foo'); # false, no boom today DESCRIPTION How many times have you found yourself writing: if ($obj->isa('Something')) { and then shortly afterwards cursing and changing it to: if (Scalar::Util::blessed($obj) and $obj->isa('Something')) { Right. That's why this module exists. Since perl allows us to provide a subroutine reference or a method name to the -> operator when used as a method call, and a subroutine doesn't require the invocant to actually be an object, we can create safe versions of isa, can and friends by using a subroutine reference that only tries to call the method if it's used on an object. So: my $isa_Foo = $maybe_an_object->$_call_if_object(isa => 'Foo'); is equivalent to my $isa_Foo = do { if (Scalar::Util::blessed($maybe_an_object)) { $maybe_an_object->isa('Foo'); } else { undef; } }; Note that we don't handle trying class names, because many things are valid class names that you might not want to treat as one (like say "Matt") - the "is_module_name" function from Module::Runtime is a good way to check for something you might be able to call methods on if you want to do that. EXPORTS $_isa $maybe_an_object->$_isa('Foo'); If called on an object, calls "isa" on it and returns the result, otherwise returns nothing. $_can $maybe_an_object->$_can('Foo'); If called on an object, calls "can" on it and returns the result, otherwise returns nothing. $_does $maybe_an_object->$_does('Foo'); If called on an object, calls "does" on it and returns the result, otherwise returns nothing. $_DOES $maybe_an_object->$_DOES('Foo'); If called on an object, calls "DOES" on it and returns the result, otherwise returns nothing. $_call_if_object $maybe_an_object->$_call_if_object(method_name => @args); If called on an object, calls "method_name" on it and returns the result, otherwise returns nothing. SEE ALSO I gave a lightning talk on this module (and curry and Import::Into) at YAPC::NA 2013 . AUTHOR mst - Matt S. Trout (cpan:MSTROUT) CONTRIBUTORS None yet. Well volunteered? :) COPYRIGHT Copyright (c) 2012 the Safe::Isa "AUTHOR" and "CONTRIBUTORS" as listed above. LICENSE This library is free software and may be distributed under the same terms as perl itself. Safe-Isa-1.000005/t/000755 000767 000024 00000000000 12373754033 014055 5ustar00etherstaff000000 000000 Safe-Isa-1.000005/t/safe_isa.t000644 000767 000024 00000002005 12304747474 016016 0ustar00etherstaff000000 000000 use strict; use warnings FATAL => 'all'; use Test::More tests => 15; { package Foo; sub new { bless({}, $_[0]) } } { package Bar; our @ISA = qw(Foo); sub bar { 1 } } my $foo = Foo->new; my $bar = Bar->new; my $blam = [ 42 ]; # basic isa usage - ok($foo->isa('Foo'), 'foo isa Foo'); ok($bar->isa('Foo'), 'bar isa Foo'); ok(!eval { $blam->isa('Foo'); 1 }, 'blam goes blam'); ok(!$foo->can('bar'), 'foo !can bar'); ok($bar->can('bar'), 'bar can bar'); ok(!eval { $blam->can('bar'); 1 }, 'blam goes blam'); use Safe::Isa; ok($foo->$_isa('Foo'), 'foo $_isa Foo'); ok($bar->$_isa('Foo'), 'bar $_isa Foo'); ok(eval { $blam->$_isa('Foo'); 1 }, 'no boom today'); ok(!$foo->$_can('bar'), 'foo !$_can bar'); ok($bar->$_can('bar'), 'bar $_can bar'); ok(eval { $blam->$_can('bar'); 1 }, 'no boom today'); ok($foo->$_call_if_object(isa => 'Foo'), 'foo $_call_if_object(isa => Foo)'); ok($bar->$_call_if_object(isa => 'Foo'), 'bar $_call_if_object(isa => Foo)'); ok(eval { $blam->$_call_if_object(isa => 'Foo'); 1 }, 'no boom today'); Safe-Isa-1.000005/maint/bump-version000755 000767 000024 00000001623 12373752757 017313 0ustar00etherstaff000000 000000 #!/usr/bin/env perl use 5.010; use strict; use warnings FATAL => 'all'; use autodie; chomp(my $LATEST = qx(grep '^[0-9]' Changes | head -1 | awk '{print \$1}')); my @parts = map { m/(\d{1,3})/g } split /\./, $LATEST; push @parts, 0, 0; my $OLD_DECIMAL = sprintf('%i.%03i%03i', @parts[0..2]); my %bump_part = (major => 0, minor => 1, bugfix => 2); my $bump_this = $bump_part{$ARGV[0]||'bugfix'} // die "no idea which part to bump - $ARGV[0] means nothing to me"; my @new_parts = @parts; $new_parts[$bump_this]++; my $NEW_DECIMAL = sprintf('%i.%03i%03i', @new_parts[0..2]); my @PM_FILES = ( 'lib/Safe/Isa.pm' ); foreach my $filename (@PM_FILES) { warn "Bumping $OLD_DECIMAL -> $NEW_DECIMAL in $filename\n"; my $file = do { local (@ARGV, $/) = ($filename); <> }; $file =~ s/(?<=\$VERSION = ')${\quotemeta $OLD_DECIMAL}/${NEW_DECIMAL}/; open my $out, '>', $filename; print $out $file; } Safe-Isa-1.000005/maint/Makefile.include000644 000767 000024 00000000275 12373752726 020017 0ustar00etherstaff000000 000000 bump: maint/bump-version rm Makefile bumpminor: maint/bump-version minor rm Makefile bumpmajor: maint/bump-version major rm Makefile upload: $(DISTVNAME).tar$(SUFFIX) cpan-upload $< Safe-Isa-1.000005/maint/Makefile.PL.include000644 000767 000024 00000000406 12216476761 020323 0ustar00etherstaff000000 000000 BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar; use ExtUtils::MakeMaker 6.68; # ensure meta-spec v2 compatibility author 'mst - Matt S. Trout (cpan:MSTROUT) '; 1; Safe-Isa-1.000005/lib/Safe/000755 000767 000024 00000000000 12373754033 015236 5ustar00etherstaff000000 000000 Safe-Isa-1.000005/lib/Safe/Isa.pm000644 000767 000024 00000010354 12373753654 016323 0ustar00etherstaff000000 000000 package Safe::Isa; use strict; use warnings FATAL => 'all'; use Scalar::Util qw(blessed); use Exporter 5.57 qw(import); our $VERSION = '1.000005'; our @EXPORT = qw($_call_if_object $_isa $_can $_does $_DOES); our $_call_if_object = sub { my ($obj, $method) = (shift, shift); # This is intentionally a truth test, not a defined test, otherwise # we gratuitously break modules like Scalar::Defer, which would be # un-perlish. return unless blessed($obj); return $obj->$method(@_); }; our ($_isa, $_can, $_does, $_DOES) = map { my $method = $_; sub { my $obj = shift; $obj->$_call_if_object($method => @_) } } qw(isa can does DOES); =head1 NAME Safe::Isa - Call isa, can, does and DOES safely on things that may not be objects =head1 SYNOPSIS use strict; use warnings; { package Foo; sub new { bless({}, $_[0]) } } { package Bar; our @ISA = qw(Foo); sub bar { 1 } } my $foo = Foo->new; my $bar = Bar->new; my $blam = [ 42 ]; # basic isa usage - $foo->isa('Foo'); # true $bar->isa('Foo'); # true $blam->isa('Foo'); # BOOM $foo->can('bar'); # false $bar->can('bar'); # true $blam->can('bar'); # BOOM # Safe::Isa usage - use Safe::Isa; $foo->$_isa('Foo'); # true $bar->$_isa('Foo'); # true $blam->$_isa('Foo'); # false, no boom today $foo->$_can('bar'); # false $bar->$_can('bar'); # true $blam->$_can('bar'); # false, no boom today Similarly: $maybe_an_object->$_does('RoleName'); # true or false, no boom today $maybe_an_object->$_DOES('RoleName'); # true or false, no boom today And just in case we missed a method: $maybe_an_object->$_call_if_object(name => @args); Or to re-use a previous example for purposes of explication: $foo->$_call_if_object(isa => 'Foo'); # true $bar->$_call_if_object(isa => 'Foo'); # true $blam->$_call_if_object(isa => 'Foo'); # false, no boom today =head1 DESCRIPTION How many times have you found yourself writing: if ($obj->isa('Something')) { and then shortly afterwards cursing and changing it to: if (Scalar::Util::blessed($obj) and $obj->isa('Something')) { Right. That's why this module exists. Since perl allows us to provide a subroutine reference or a method name to the -> operator when used as a method call, and a subroutine doesn't require the invocant to actually be an object, we can create safe versions of isa, can and friends by using a subroutine reference that only tries to call the method if it's used on an object. So: my $isa_Foo = $maybe_an_object->$_call_if_object(isa => 'Foo'); is equivalent to my $isa_Foo = do { if (Scalar::Util::blessed($maybe_an_object)) { $maybe_an_object->isa('Foo'); } else { undef; } }; Note that we don't handle trying class names, because many things are valid class names that you might not want to treat as one (like say "Matt") - the C function from L is a good way to check for something you might be able to call methods on if you want to do that. =head1 EXPORTS =head2 $_isa $maybe_an_object->$_isa('Foo'); If called on an object, calls C on it and returns the result, otherwise returns nothing. =head2 $_can $maybe_an_object->$_can('Foo'); If called on an object, calls C on it and returns the result, otherwise returns nothing. =head2 $_does $maybe_an_object->$_does('Foo'); If called on an object, calls C on it and returns the result, otherwise returns nothing. =head2 $_DOES $maybe_an_object->$_DOES('Foo'); If called on an object, calls C on it and returns the result, otherwise returns nothing. =head2 $_call_if_object $maybe_an_object->$_call_if_object(method_name => @args); If called on an object, calls C on it and returns the result, otherwise returns nothing. =head1 SEE ALSO I gave a lightning talk on this module (and L and L) at L. =head1 AUTHOR mst - Matt S. Trout (cpan:MSTROUT) =head1 CONTRIBUTORS None yet. Well volunteered? :) =head1 COPYRIGHT Copyright (c) 2012 the Safe::Isa L and L as listed above. =head1 LICENSE This library is free software and may be distributed under the same terms as perl itself. =cut