view release on metacpan or  search on metacpan

lib/Object/Pad.pm  view on Meta::CPAN

   }

In larger examples with lots of non-trivial method bodies, it can get
confusing to remember where the field variables come from (because we no
longer have the C<< $self->{ ... } >> visual clue). In these cases it is
suggested to prefix the field names with a leading underscore, to make them
more visually distinct.

   class Spudger {
      field $_grapefruit;

      ...

      method mangle {
         $_grapefruit->peel; # The leading underscore reminds us this is a field
      }
   }

=cut

sub VERSION
{
   my $pkg = shift;

   my $ret = $pkg->SUPER::VERSION( @_ );

   if( @_ ) {
      my $ver = version->parse( @_ );

      # Only bother to store it if it's >= v0.800
      $^H{"Object::Pad/imported-version"} = $ver->numify if $ver ge v0.800;
   }

   return $ret;
}

sub import
{
   my $class = shift;
   my $caller = caller;

   $class->import_into( $caller, @_ );
}

sub _import_experimental
{
   shift;
   my ( $syms, @experiments ) = @_;

   my %enabled;

   my $i = 0;
   while( $i < @$syms ) {
      my $sym = $syms->[$i];

      if( $sym eq ":experimental" ) {
         carp "Enabling all Object::Pad experiments with an unqualified :experimental";
         $enabled{$_}++ for @experiments;
      }
      elsif( $sym =~ m/^:experimental\((.*)\)$/ ) {
         foreach my $tag ( split m/\s+/, $1 =~ s/^\s+|\s+$//gr ) {
            if( $tag eq ":all" ) {
               $enabled{$_}++ for @experiments;
            }
            else {
               $enabled{$tag}++;
            }
         }
      }
      else {
         $i++;
         next;
      }

      splice @$syms, $i, 1, ();
   }

   foreach ( @experiments ) {
      $^H{"Object::Pad/experimental($_)"}++ if delete $enabled{$_};
   }

   croak "Unrecognised :experimental features @{[ keys %enabled ]}" if keys %enabled;
}

sub _import_configuration
{
   shift;
   my ( $syms ) = @_;

   # Undocumented options, purely to support Feature::Compat::Class adjusting
   # the behaviour to closer match core's  use feature 'class'

   my $i = 0;
   while( $i < @$syms ) {
      my $sym = $syms->[$i];

      if( $sym =~ m/^:config\((.*)\)$/ ) {
         foreach my $opt ( split m/\s+/, $1 =~ s/^\s+|\s+$//gr ) {
            if( $opt =~ m/^(only_class_attrs|only_field_attrs)=(.*)$/ ) {
               # Store an entire sub-hash inside the hints hash. This won't
               # survive squashing into a COP for runtime but we only need it
               # during compile so that's OK
               my ( $name, $attrs ) = ( $1, $2 );
               $^H{"Object::Pad/configure($name)"} = { map { $_ => 1 } split m/,/, $attrs };
            }
            else {
               $^H{"Object::Pad/configure($opt)"}++
            }
         }
      }
      else {
         $i++;
         next;
      }

      splice @$syms, $i, 1, ();
   }
}

sub import_into
{
   my $class = shift;
   my $caller = shift;

   $class->_import_experimental( \@_, qw( init_expr mop custom_field_attr adjust_params composed_adjust inherit_field apply_phaser lexical_class ) );

   $class->_import_configuration( \@_ );

   my %syms = map { $_ => 1 } @_;

   # Default imports
   unless( %syms ) {
      $syms{$_}++ for qw( class role inherit apply method field has requires BUILD ADJUST APPLY );
   }

   delete $syms{$_} and $^H{"Object::Pad/$_"}++ for qw( class role inherit apply method field has requires BUILD ADJUST APPLY );

   croak "Unrecognised import symbols @{[ keys %syms ]}" if keys %syms;
}

# The universal base-class methods

sub Object::Pad::UNIVERSAL::BUILDARGS
{
   shift; # $class
   return @_;
}

# Back-compat wrapper
sub Object::Pad::MOP::SlotAttr::register
{
   shift; # $class
   croak "Object::Pad::MOP::SlotAttr->register is now removed; use Object::Pad::MOP::FieldAttr->register instead";
}

=head1 WITH OTHER MODULES

=head2 Syntax::Keyword::Dynamically

A cross-module integration test asserts that C<dynamically> works correctly
on object instance fields:

   use Object::Pad;
   use Syntax::Keyword::Dynamically;