Skip to content

Commit

Permalink
Item14152: Merge commit '128af377dc5eb6d4eb4e0b376e156017e2e4490f' in…
Browse files Browse the repository at this point in the history
…to Item14152

* commit '128af377dc5eb6d4eb4e0b376e156017e2e4490f':
  Item13897: Getting list of class attributes.
  • Loading branch information
vrurg committed Dec 20, 2016
2 parents 6e53a93 + 128af37 commit 334de39
Show file tree
Hide file tree
Showing 2 changed files with 173 additions and 14 deletions.
112 changes: 111 additions & 1 deletion core/lib/Foswiki/Class.pm
Expand Up @@ -109,7 +109,73 @@ use constant DEFAULT_FEATURESET => ':5.14';

our @ISA = qw(Moo);

my %_assignedRoles;
my ( %_assignedRoles, %_registeredAttrs, %_ISA, %_WITH );

# BEGIN Install wrappers for Moo's has/with/extends to record basic object information. Works only when $ENV{FOSWIKI_ASSERTS} is true.
sub _fw_has {
my $target = shift;
my ($attr) = @_;

#say STDERR "Registering attr $attr on $target";

push @{ $_registeredAttrs{$target}{list} },
{ attr => $attr, options => [ @_[ 1 .. $#_ ] ] };
}

sub _fw_with {
my $target = shift;

#say STDERR "$target WITH ", join( ", ", @_ );
push @{ $_WITH{$target} }, @_;
}

sub _fw_extends {
my $target = shift;

#say STDERR "$target EXTENDS ", join( ", ", @_ );
push @{ $_ISA{$target} }, @_;
}

if ( $ENV{FOSWIKI_ASSERTS} ) {

# Moo doesn't provide a clean way to get all object's attributes. The only
# really clean way to distinguish between a key on object's hash and an
# attribute is to record what is passed to Moo's sub 'has'. Since Moo
# generates it for each class separately (as well as other 'keywords') and
# since Moo::Role does it on its own too then the only really clean way to
# catch everything is to tap into Moo's guts. And the best way to do so is
# to intercept calls to _install_tracked() as this sub is used to register
# every single Moo-generated code ref. Though this is a hacky way on its own
# but the rest approaches seem to be even more hacky and no doubt
# unreliable.
foreach my $module (qw(Moo Moo::Role)) {
my $ns = Foswiki::getNS($module);
my $_install_tracked = *{ $ns->{'_install_tracked'} }{CODE};
_inject_code(
$module,
'_install_tracked',
sub {
my $ovCode;
my $target = $_[0];
my $codeName = $_[1];
my $ovSubName = "_fw_" . $_[1];
$ovCode = __PACKAGE__->can($ovSubName);
if ($ovCode) {

#say STDERR "Installing wrapper $codeName on $target";
my $origCode = $_[2];
$_[2] = sub {
$ovCode->( $target, @_ );
goto &$origCode;
};
}
goto &$_install_tracked;
}
);
}
}

# END of has/with/extends wrappers.

sub import {
my ($class) = shift;
Expand Down Expand Up @@ -184,6 +250,44 @@ sub import {
goto &Moo::import;
}

sub _getAllAttrs {
foreach my $class (@_) {
my @classAttrs;
if ( defined $_registeredAttrs{$class} ) {
if ( defined $_registeredAttrs{$class}{cached} ) {

# Skip the class if already cached.
next;
}
if ( defined $_registeredAttrs{$class}{list} ) {
push @classAttrs,
map { $_->{attr} } @{ $_registeredAttrs{$class}{list} };
}
}
if ( defined $_ISA{$class} ) {
push @classAttrs, _getAllAttrs( @{ $_ISA{$class} } );
}
if ( defined $_WITH{$class} ) {
push @classAttrs, _getAllAttrs( @{ $_WITH{$class} } );
}
$_registeredAttrs{$class}{cached} = \@classAttrs;
}
return map { @{ $_registeredAttrs{$_}{cached} } } @_;
}

sub getClassAttributes {
my $class = shift;

#require Data::Dumper;

#say STDERR Data::Dumper->Dump(
# [ \%_registeredAttrs, \%_ISA, \%_WITH ],
# [qw(%_registeredAttrs %_ISA %_WITH)]
#);

return _getAllAttrs($class);
}

# Actually we're duplicating Moo::_install_coderef here in a way. But we better
# avoid using a module's internalls.
sub _inject_code {
Expand All @@ -195,6 +299,12 @@ sub _inject_code {
sub _apply_roles {
my $class = shift;
foreach my $target ( keys %_assignedRoles ) {

#say STDERR "Applying roles ",
# join( ", ", @{ $_assignedRoles{$target} } ), " to $target";

push @{ $_WITH{$target} }, @{ $_assignedRoles{$target} };

Moo::Role->apply_roles_to_package( $target,
@{ $_assignedRoles{$target} } );
$class->_maybe_reset_handlemoose($target);
Expand Down
75 changes: 62 additions & 13 deletions core/lib/Foswiki/Object.pm
Expand Up @@ -190,15 +190,17 @@ sub DEMOLISH {
$this->finish;
}
if (DEBUG) {
my %validAttrs =
map { $_ => 1 } $this->classAttributes( ref($this) );
foreach my $key ( keys %{$this} ) {
unless ( $key =~ /^(?:__)+orig_/ || $this->can($key) ) {
unless ( $validAttrs{$key} || $key =~ /^(?:__)+orig_/ ) {
say STDERR "Key $key on ", ref($this),
" isn't a valid attribute.";
" isn't an attribute declared with Moo::has.",
( join( ", ", sort keys %validAttrs ) );
if ( UNIVERSAL::isa( $this->{key}, 'Foswiki::Object' ) ) {
say STDERR " $key is a Foswiki::Object created in ",
$this->{key}->__orig_file, ":", $this->{key}->__orig_line;
}

}
}
}
Expand Down Expand Up @@ -306,14 +308,42 @@ sub _cloneData {

=begin TML
---++ ClassMethod classAttributes -> \@attributes
A convenience shortcat to =Foswiki::Class::getClassAttributes()=.
Returns a list of names of class attributes.
This method could be used both as class and object method:
<verbatim>
my @attrs = $obj->classAttributes;
@attrs = Foswiki::Object->classAttributes;
</verbatim>
=cut

sub classAttributes {
my $class = shift;

# Make both class and object method style calls possible.
$class = ref($class) || $class;
return Foswiki::Class::getClassAttributes($class);
}

=begin TML
---++ ObjectMethod clone() -> $clonedObject
This method tries to do it's best to create an exact copy of existing object.
For that purpose this method considers a object as a data structure and
traverses it recursively creating a profile for new object's constructor. All
keys on object's hash are considered as attributes to be inserted into the
profile. In other words it means then if we have an object with keys =key1=, =key2=, and =key3=
then new object's constructor will get the following profile:
profile. In other words it means then if we have an object with keys =key1=,
=key2=, and =key3= then new object's constructor will get the following profile:
<verbatim>
my @profile = (
Expand All @@ -324,17 +354,35 @@ my @profile = (
my $newObj = ref($this)->new( @profile );
</verbatim>
Actually the process is a bit more complicated than this example. It is guided by the following rules:
Actually the process is a bit more complicated than this example. It is guided
by the following rules:
1. If a key name begins with =__[__[...]]orig_= prefix it is used for debugging needs and keeps object's creation history. To preserve the history such keys are prefixed with additional =__= prefix. So, a clone of clone would have three kopies of such keys prefixed with =__orig_=, =____orig_=, and =______orig_=.
1. If a key name begins with =__[__[...]]orig_= prefix it is used for
debugging needs and keeps object's creation history. To preserve the
history such keys are prefixed with additional =__= prefix. So, a clone of
clone would have three kopies of such keys prefixed with =__orig_=,
=____orig_=, and =______orig_=.
1. All other attributes with =__= prefixed names are ignored and not duplicated.
1. If a class wants to take care of cloning of an attribute it can define a =_clone_<attribute_name>()= method (say, =_clone_key2()= for the above example; or =_clone__attr()= for private attribute =_attr=). In this case the attribute value won't be traversed and return from the =_clone_<attribute_name>()= method would be used.
1. For blessed references discovered during traversal their =clone()= method is used to create a copy if their respective classes have this method defined.
1. For objects without =clone()= method they're copied as a hash which is then blessed into the object's class. *NOTE* This won't work for non-hash blessed references. They're must be taken care by the class the attribute belongs to.
1. If a class wants to take care of cloning of an attribute it can define a
=_clone_<attribute_name>()= method (say, =_clone_key2()= for the above
example; or =_clone__attr()= for private attribute =_attr=). In this case
the attribute value won't be traversed and return from the
=_clone_<attribute_name>()= method would be used.
1. For blessed references discovered during traversal their =clone()= method
is used to create a copy if their respective classes have this method
defined.
1. For objects without =clone()= method they're copied as a hash which is
then blessed into the object's class. *NOTE* This won't work for non-hash
blessed references. They're must be taken care by the class the attribute
belongs to.
1. Regexp's refs are just copied into destination.
1. Attributes containing references of *ARRAY*, *HASH*, and *SCALAR* types are cloned; refs of other types are just copied into destination.
1. Attributes containing references of *ARRAY*, *HASH*, and *SCALAR* types
are cloned; refs of other types are just copied into destination.
1. If a reference is weakened it's clone is weakened too.
1. If same reference found at two or more locations of cloned object's structure then destination object will have identical cloned references at same locations; i.e. if =$this->attr1 == $this->attr2->subattr->[3]= then =$cloned->attr1 == $cloned->attr2->subattr->[3]= too.
1. If same reference found at two or more locations of cloned object's
structure then destination object will have identical cloned references at
same locations; i.e. if =$this->attr1 == $this->attr2->subattr->[3]= then
=$cloned->attr1 == $cloned->attr2->subattr->[3]= too.
1. Circular dependecies are raising =Foswiki::Exception::Fatal=.
=cut
Expand Down Expand Up @@ -373,7 +421,8 @@ sub clone {
push @profile, $destAttr, $attrVal;
}

# SMELL Should it be better to use same approach as in _cloneData - just bless a profile hash?
# SMELL Should it be better to use same approach as in _cloneData - just
# bless a profile hash?
my $newObj = ref($this)->new(@profile);

$this->_clear__clone_heap;
Expand Down

0 comments on commit 334de39

Please sign in to comment.