view release on metacpan or  search on metacpan

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

#
# 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 {
  my ($class, @array) = @_;
  ### ConnectProperties new()

  if (@array < 2) {
    croak 'ConnectProperties: new() must have two or more object/property pairs';
  }

  # validate property names before making signal connections
  foreach my $elem (@array) {
    my ($object, $pname, @params) = @$elem;

    # for reference ParamSpec demands pname first char [A-Za-z] and then any
    # non [A-Za-z0-9-] crunched by canonical_key() to "-"s
    my $flavour;
    if ($pname =~ /(.*?)#(.*)/) {
      $pname = $2;
      ($flavour = $1) =~ tr/-/_/;
    } else {
      $flavour = 'object';
    }
    my $elem_class = "Glib::Ex::ConnectProperties::Element::$flavour";
    ### $elem_class
    Module::Load::load ($elem_class);

    # replacing element in @array
    $elem = $elem_class->new (object => $object,
                              pname  => $pname,
                              @params);
    $elem->check_property;
  }
  my $self = bless { array => \@array }, $class;
  my $first_readable_elem;

  foreach my $elem (@array) {
    if (my $h = delete $elem->{'hash_in'}) {
      ### hash_in func: "@{[keys %$h]}"
      $elem->{'func_in'} = _make_hash_func ($h);
    }
    if (my $h = delete $elem->{'hash_out'}) {
      ### hash_out func: "@{[keys %$h]}"
      $elem->{'func_out'} = _make_hash_func ($h);
    }

    if (delete $elem->{'bool_not'}) {
      $elem->{'func_in'} =  $elem->{'func_out'} = \&_bool_not;
    }

    Scalar::Util::weaken ($elem->{'object'});

    if (! delete $elem->{'write_only'} && $elem->is_readable) {
      $first_readable_elem ||= $elem;
      $elem->{'self'} = $self;
      $elem->connect_signals;
      Scalar::Util::weaken ($elem);  # the element of $self->{'array'}
    }
  }

  # set initially from first readable, in case not already the same
  if ($first_readable_elem) {
    ### initial propagate
    _do_read_handler ($first_readable_elem->{'object'}, $first_readable_elem);
  }
  return $self;
}

sub dynamic {
  my $self = shift->new(@_);
  foreach my $elem (@{$self->{'array'}}) {
    Scalar::Util::weaken ($elem->{'self'});
  }
  return $self;
}

# For a permanent new() style connection DESTROY is only reached when all
# readable objects are gone already, so there's nothing to disconnect.  But
# a dynamic() is garbage collected with signal connections still present,
# hence an explicit disconnect() here.
#
sub DESTROY {
  my ($self) = @_;
  $self->disconnect;
}

sub disconnect {
  my ($self) = @_;
  my $array = $self->{'array'};
  ### ConnectProperties disconnect: "$self ".scalar(@$array)." elems"
  while (my $elem = pop @$array) {
    $elem->disconnect;
  }
}

my $value_validate_method
  = (
     # Perl-Glib 1.200, value_validate() not wrapped
     ! Glib::ParamSpec->can('value_validate')
     ? sub {
       my ($pspec, $value) = @_;
       return (0,$value); # unmodified, original value, always wantarray
     }

     # Perl-Glib 1.220, value_validate() buggy on non ref counted boxed types
     : ! eval{Glib->VERSION(1.240);1}
     ? sub {
       my ($pspec, $value) = @_;
       my $type = $pspec->get_value_type;
       if ($type->isa('Glib::Boxed') && ! $type->isa('Glib::Scalar')) {
         return (0,$value); # unmodified, original value, always wantarray
       }
       return $pspec->value_validate ($value);
     }

     # Perl-Glib 1.240, value_validate() good
     : 'value_validate');

# 'notify' or read_signal handler from a connected object
sub _do_read_handler {
  my $from_elem = $_[-1];
  my $self = $from_elem->{'self'};

  ### ConnectProperties _do_read_handler: "$self $_[0]/" . ($from_elem->{'pname'} || '[false]')
  ###   notify_in_progress: $self->{'notify_in_progress'}

  if ($self->{'notify_in_progress'}) { return; }
  local $self->{'notify_in_progress'} = 1;

  my $from_val = $from_elem->get_value;
  ###   from_value to propagate: $from_val
  if (my $func = $from_elem->{'func_out'}) {