File Coverage

blib/lib/Mojar/ClassShare.pm

Criterion	Covered	Total	%
statement	47	49	95.9
branch	21	28	75.0
condition	6	12	50.0
subroutine	10	10	100.0
pod	0	1	0.0
total	84	100	84.0

package Mojar::ClassShare;
use strict;
use warnings;

our $VERSION = 0.011;
# Adapted from Mojo::Base::attr

use Carp 'croak';

sub import {
  my $class = shift;
  if (@_ and shift eq 'have') {
    my $caller = caller;
    no strict 'refs';
    *{"${caller}::have"} = sub { class_attr($caller, @_) };
  }
}

# Public method

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

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

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

    # Header (check arguments)
    my $code = "package $class;\nsub $attr {\n  no strict 'refs';\n";
    $code .= "  if (\@_ == 1) {\n";

    # No default value (return value)
    unless (defined $default) { $code .= "    return \$_[0]{'$attr'};" }

    # Default value
    else {

      # Return value
      $code .= "    return \$_[0]{'$attr'} if exists \$_[0]{'$attr'};\n";

      # Return default value
      $code .= "    return \$_[0]{'$attr'} = ";
      $code .= ref $default eq 'CODE' ? '$default->($_[0]);' : '$default;';
    }

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

    # Footer (return invocant)
    $code .= "  \$_[0];\n}";

    warn "-- Attribute $attr in $class\n$code\n\n" if $ENV{MOJO_BASE_DEBUG};
    croak "Mojo::Base error: $@" unless eval "$code;1";
  }
}

1;
__END__