view release on metacpan or  search on metacpan

lib/Momo.pm  view on Meta::CPAN

package Momo;

# ABSTRACT: a simple oop module inspired from Mojo::Base and Moo
use utf8;
use strict;
use warnings;
use Carp;
use Role::Tiny ();
use Scalar::Util qw(set_prototype);
use Class::Method::Modifiers;

our $VERSION = 1.2;

sub import {
    my $class = shift;

    {
        no strict 'refs';
        no warnings 'redefine';

        my $package = caller;
        push @{ $package . '::ISA' }, 'Momo';
        # install methodes into package,make the package get magic feature
        # install class method modifiers
        if( not defined &{ $package."::has" } ){
            *{ $package . '::has' } = sub { attr( $package, @_ ) };
        }
        if( not defined &{ $package."::extends" } ) {
            *{ $package . '::extends' } = sub {
            for (@_) {
                ( my $file = $_ ) =~ s!::|'!/!g;
                eval { require "$file.pm" };
                push @{ $package . '::ISA' }, $_;
            }
            };
        }
        if( not defined &{ $package."::with" } ){
        *{ $package . '::with' } = sub {
            Role::Tiny->apply_roles_to_package( $package, @_ );
        };
        }
        for my $method (qw(before after around)) {
            *{ $package . '::' . $method } = sub {
                Class::Method::Modifiers::install_modifier( $package, $method,
                    @_ );
            };
        }
        set_prototype \&{ $package . '::extends' }, '@';
        set_prototype \&{ $package . '::with' },    '@';
    }
    strict->import;
    warnings->import;
    utf8->import;
    Carp->import;
    if ( $] >= 5.010 ) {
        require 'feature.pm';
        feature->import( ':' . substr("$^V",1,4) );
    }

}

sub new {
    my $class = shift;
    bless @_ ? @_ > 1 ? {@_} : { %{ $_[0] } } : {}, ref $class || $class;
}

sub attr {
    my ( $class, $attrs, $default ) = @_;
    return unless ( $class = ref $class || $class ) && $attrs;

    Carp::croak 'Default has to be a code reference or constant value'
      if ref $default && ref $default ne 'CODE';

    # Compile attributes
    for my $attr ( @{ ref $attrs eq 'ARRAY' ? $attrs : [$attrs] } ) {
        Carp::croak qq{Attribute "$attr" invalid}
          unless $attr =~ /^[a-zA-Z_]\w*$/;

        my $code = "package $class;\nsub $attr {\n  if (\@_ == 1) {\n";
        unless ( defined $default ) { $code .= "    return \$_[0]{'$attr'};" }
        else {
            $code .= "    return \$_[0]{'$attr'} if exists \$_[0]{'$attr'};\n";
            $code .= "    return \$_[0]{'$attr'} = ";
            $code .=
              ref $default eq 'CODE' ? '$default->($_[0]);' : '$default;';
        }

        $code .= "\n  }\n  \$_[0]{'$attr'} = \$_[1];\n";
        $code .= "  \$_[0];\n}";

        no strict 'refs';
        warn "-- Attribute $attr in $class\n$code\n\n" if $ENV{MOMO_DEBUG};
        Carp::croak "Momo error: $@" unless eval "$code;1";
    }
}

sub tap {
    my ( $self, $cb ) = @_;
    $_->$cb for $self;
    return $self;
}

1;

=encoding utf8

=head1 NAME

Momo,a simple oop module inspired from Mojo::Base and Moo.

=head1 SYNOPSIS