Glib-Ex-ConnectProperties

 view release on metacpan or  search on metacpan

lib/Glib/Ex/ConnectProperties.pm  view on Meta::CPAN

our $VERSION = 20;

# uncomment this to run the ### lines
#use Smart::Comments;


# Hard/weak refs are as follows.
#
# * Readable property in new() permanent linkage -- the $object signal
#   connection has a hard ref to $elem, and $elem->{'self'} has a hard ref
#   to $self, so $elem is kept alive while $object lives.  The entry for
#   $elem within connp $self->{'array'} is weak so that $elem goes away when
#   $object is destroyed.
#
# * Readable property in dynamic() linkage -- $elem->{'self'} is weak, which
#   means $self can be garbage collected.  Each $elem is still kept alive by
#   the signal connection, but $self->DESTROY drops those connections.
#
# * Write-only property -- there's no signal connection, and $self has a
#   hard ref to $elem, with nothing from $elem back to $self.  The
#   write-onlys don't keep $self alive, only the readables.  Once the last
#   readable object is destroyed the $self and write-onlys are destroyed.
#
# In all cases $elem->{'object'} is only a weak ref to the target $object so
# a ConnectProperties never keeps a target object alive.
#
# When $self->{'array'} gets down to just one element (one readable one)
# it'd be possible to discard it as there's nowhere for its "notify" to
# propagate values to.  But maybe an add() could be made to extend an
# existing linkage, in which case would still want that last element.  Maybe
# could go dynamic() style when down to one element, so if nothing else
# cares about the linkage then destroy the lot.
#

sub new {

lib/Glib/Ex/ConnectProperties.pm  view on Meta::CPAN

    my $to_val = $from_val;
    if (my $func = $to_elem->{'func_in'}) {
      $to_val = $func->($to_val);
      ###   func_in becomes: $to_val
    }

    # value_validate() to clamp $to_val for $to_pspec
    # value_validate() is wrapped in Glib 1.220, remove the check when ready
    # to demand that version
    # In 1.240 may have to keep a new non ref counted boxed return from
    # func_in() alive if value_validate() makes an alias, hence
    # $to_val_keepalive.
    #
    my $to_val_keepalive = $to_val;
    (undef, $to_val) = $to_pspec->$value_validate_method($to_val);

    # skip if target already contains $to_val, to avoid extra 'notify's
    if ($to_flags & 'readable') {
      if (_pspec_equal ($to_pspec, $to_elem->get_value, $to_val)) {
        ###   suppress already equal: "$to_object/".($to_elem->{'pname'} || '[false]')
        next;
      }
    }

t/ConnectProperties.t  view on Meta::CPAN

{
  my $obj1 = Foo->new (myprop_one => 1, myprop_two => 1);
  my $obj2 = Foo->new (myprop_one => 0, myprop_two => 0);
  my $conn = Glib::Ex::ConnectProperties->new ([$obj1,'myprop-one'],
                                               [$obj2,'myprop-two']);
  require Scalar::Util;

  my $weak_obj1 = $obj1;
  Scalar::Util::weaken ($weak_obj1);
  $obj1 = undef;
  is ($weak_obj1, undef, 'obj1 not kept alive');

  my $weak_obj2 = $obj2;
  Scalar::Util::weaken ($weak_obj2);
  $obj2 = undef;
  is ($weak_obj2, undef, 'obj2 not kept alive');

  Scalar::Util::weaken ($conn);
  is ($conn, undef, 'conn garbage collected when none left');
}

{
  my $obj1 = Foo->new (myprop_one => 1, myprop_two => 0);
  my $obj2 = Foo->new (myprop_one => 0, myprop_two => 1);
  my $conn = Glib::Ex::ConnectProperties->new ([$obj1,'myprop-one'],
                                               [$obj2,'myprop-two']);

t/ConnectProperties.t  view on Meta::CPAN

  my $obj1 = Foo->new (myprop_one => 1, myprop_two => 1);
  my $obj2 = Foo->new (myprop_one => 0, myprop_two => 0);
  my $conn = Glib::Ex::ConnectProperties->new ([$obj1,'myprop-one'],
                                               [$obj2,'myprop-two',
                                                write_only => 1]);
  require Scalar::Util;

  my $weak_obj1 = $obj1;
  Scalar::Util::weaken ($weak_obj1);
  $obj1 = undef;
  is ($weak_obj1, undef, 'obj1 not kept alive');

  Scalar::Util::weaken ($conn);
  is ($conn, undef, 'conn garbage collected when last readable gone');
}

#-----------------------------------------------------------------------------
# write-only

{
  my $obj1 = Foo->new;