Chorus-Engine

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for Chorus::Expert

1.03    2015-12-14
		- Some tests added (Chorus::Frame : get - set - delete - getZ - getN - fmatch - weaken
		- Frame method inherits() renamed to _inherits()
		- bug 90530 : fixed - pod test only if $ENV{AUTHOR_TESTING}

1.02    2013-12-18
        - Chorus::Frame : DESTROY debbuged (unblessed reference)
        - Chorus::Frame : method _inherits() added
        - Chorus::Frame : fmatch() new syntax fmatch(slot => 'SLOT_NAME') or fmatch(slot => ['SLOT1_NAME', 'SLOT2_NAME'])
        - Chorus::Frame : fmatch() optimized with %INSTANCES
        - Chorus::Frame : _push() method added
        - Chorus::Frame : bug fixed with set + multiple inheritance

lib/Chorus/Frame.pm  view on Meta::CPAN

  @ISA         = qw(Exporter);
  @EXPORT      = qw($SELF &fmatch REQUIRE_FAILED);
  @EXPORT_OK   = qw(%FMAP);	

  # %EXPORT_TAGS = ( );		# eg: TAG => [ qw!name1 name2! ];
}

use strict;
use Carp;			# warn of errors (from perspective of caller)
use Digest::MD5;
use Scalar::Util qw(weaken);

use Data::Dumper;

use constant DEBUG_MEMORY => 0;

use vars qw($AUTOLOAD);

use constant SUCCESS        =>  1;
use constant FAILED         =>  0;
use constant REQUIRE_FAILED => -1;

lib/Chorus/Frame.pm  view on Meta::CPAN

  return unless scalar(@elems);
  $this->{$slot} = [ $this->{$slot} || () ] unless ref($this->{$slot}) eq 'ARRAY'; 
  unshift @{$this->{$slot}}, @elems;
}

sub _addInstance {
  my ($this, $instance) = @_;
  my $k = $instance->{_KEY};
  
  $INSTANCES{$this->{_KEY}}->{$k} = $instance;
  weaken($INSTANCES{$this->{_KEY}}->{$k});      # will not increase garbage ref counter to $instance !!
}

=head2 _inherits

  add inherited new frame(s) outside constructor
  ex. $f->_inherits($F1,$F2);
=cut
  
sub _inherits {
  my ($this, @inherited) = @_;

lib/Chorus/Frame.pm  view on Meta::CPAN

    	$k = Digest::MD5::md5_base64( rand );
    } while(exists($FMAP{$k}));
 
    foreach my $slot (keys(%$this)) { # register all slots
      $REPOSITORY{$slot} = {} unless exists $REPOSITORY{$slot};
      $REPOSITORY{$slot}->{$k} = 'Y';
    }
    
    $this->{_KEY} = $k;
    $FMAP{$k} = $this;
    weaken($FMAP{$k}); # will not increase garbage ref counter to $this !!
    return $this; 
  }

  sub blessToFrameRec {

    local $_ = shift;

    if (_isa($_,'Chorus::Frame')) {
      
      while(my ($k, $val) = each %$_) {

t/16-Frame-weaken.t  view on Meta::CPAN

  
sub set_weak_frame {
	
  my $f = Chorus::Frame->new(
      WEAK_FRAME => 'Y' 
  );
  
}

sub test_weaken {
  set_weak_frame();
  return undef if fmatch(slot => 'WEAK_FRAME');
  return 1; 
}

ok(test_weaken, 'test weaken');
done_testing();