File Coverage

blib/lib/Mojo/Bass.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	13	14	92.8
condition	4	5	80.0
subroutine	8	8	100.0
pod			n/a
total	60	62	96.7

package Mojo::Bass;
$Mojo::Bass::VERSION = '0.2.0';
# ABSTRACT: Mojo::Base + lexical "has"
use 5.018;
use Mojo::Base -strict;

BEGIN {
  our @ISA = qw(Mojo::Base);
}

use Sub::Inject 0.2.0 ();

sub import {
  my $class = shift;
  return unless my @flags = @_;

  # Base
  if ($flags[0] eq '-base') { $flags[0] = $class }

  # Strict
  elsif ($flags[0] eq '-strict') { $flags[0] = undef }

  # Module
  elsif ((my $file = $flags[0]) && !$flags[0]->can('new')) {
    $file =~ s!::|'!/!g;
    require "$file.pm";
  }

  # Mojo modules are strict!
  $_->import for qw(strict warnings utf8);
  feature->import(':5.10');

  # Signatures (Perl 5.20+)
  if (($flags[1] || '') eq '-signatures') {
    Carp::croak 'Subroutine signatures require Perl 5.20+' if $] < 5.020;
    feature->import('signatures');
    warnings->unimport('experimental::signatures');
  }

  # ISA
  if ($flags[0]) {
    my $caller = caller;
    no strict 'refs';
    push @{"${caller}::ISA"}, $flags[0];
    @_ = ($caller, has => sub { Mojo::Base::attr($caller, @_) });
    goto &{$class->can('_export_into')};
  }
}

sub _export_into {
  shift;
  goto &Sub::Inject::sub_inject;
}

1;

#pod =encoding utf8
#pod
#pod =head1 SYNOPSIS
#pod
#pod   package Cat {
#pod     use Mojo::Bass -base;
#pod
#pod     has name => 'Nyan';
#pod     has ['age', 'weight'] => 4;
#pod   }
#pod
#pod   package Tiger {
#pod     use Mojo::Bass 'Cat';
#pod
#pod     has friend => sub { Cat->new };
#pod     has stripes => 42;
#pod   }
#pod
#pod   package main;
#pod   use Mojo::Bass -strict;
#pod
#pod   my $mew = Cat->new(name => 'Longcat');
#pod   say $mew->age;
#pod   say $mew->age(3)->weight(5)->age;
#pod
#pod   my $rawr = Tiger->new(stripes => 38, weight => 250);
#pod   say $rawr->tap(sub { $_->friend->name('Tacgnol') })->weight;
#pod
#pod =head1 DESCRIPTION
#pod
#pod L works like L but C is imported
#pod as lexical subroutine.
#pod
#pod =head1 CAVEATS
#pod
#pod =over 4
#pod
#pod =item *
#pod
#pod L requires perl 5.18 or newer
#pod
#pod =item *
#pod
#pod Because a lexical sub does not behave like a package import,
#pod some code may need to be enclosed in blocks to avoid warnings like
#pod
#pod     "state" subroutine &has masks earlier declaration in same scope at...
#pod
#pod =back
#pod
#pod =head1 SEE ALSO
#pod
#pod L.
#pod
#pod =cut

__END__