view release on metacpan or search on metacpan
misc/t-symlist-join.pl
misc/t-symlist-list.pl
misc/t-symlist-menu.pl
misc/t-symlist-model.pl
misc/t-symlist-tree.pl
misc/t-symlist.pl
misc/t-textbuffer.pl
misc/t-tge.pl
misc/t-ticker.pl
misc/t-tie-hash-union.pl
misc/t-tie-weaken.pl
misc/t-timebase.pl
misc/t-timer-object.pl
misc/t-tsp.pl
misc/t-useragent.pl
misc/t-variable-magic.pl
misc/t-viewstyle.pl
misc/t-volume-series.pl
misc/t-watchlist-model.pl
misc/t-widget-disc.pl
misc/t-widget-tracker.pl
SHA256 b1682b0072b76231f2aeb3ee43f1016254779810ab04ee9167622ac8d42bb442 misc/t-symlist-join.pl
SHA256 784c638ad83af9933292e4fddcfc328667e97fa2e107197ec506884ee2adc728 misc/t-symlist-list.pl
SHA256 dde37fbb4334fffdb0e54b48b71484c324f453ecf3341a6380a2ee84619dce5e misc/t-symlist-menu.pl
SHA256 c429117bfc542298d5ac3fd72f96d422eee234d00eccfb3988cf62079bdb214b misc/t-symlist-model.pl
SHA256 7b5fe4d726a897b67ec9c349557e1beb4423d09701a6672b84e90432bb9b4b4d misc/t-symlist-tree.pl
SHA256 8cbd395d5847716e606dd6becacb5831e5c3bf8257b5309c8fdde6013840beb2 misc/t-symlist.pl
SHA256 9c3740a52f3cdab7326e6ee5dc3ea6e74fda6197573877caa599ddba3816fb0e misc/t-textbuffer.pl
SHA256 79907d407d2c82a5ad137a9995a552863272d1e8d11f948dcafb3f366c88a535 misc/t-tge.pl
SHA256 23a7d8d04feedacd646bb5550862095c1d1868215d46c34586aec21c50d6cdfe misc/t-ticker.pl
SHA256 0710b0dfdfb9f96b5d4ea89e282bb6257f877c9ab14789cc51628f567441c93a misc/t-tie-hash-union.pl
SHA256 57b64e926f5c88e0a0a3c7b8b52452f7b2a3b83f05cecf95b9011839b8a86657 misc/t-tie-weaken.pl
SHA256 34e686f52a48605d1324b4e193cc31beef654e52bde7ef581e44e605ef5994f3 misc/t-timebase.pl
SHA256 1db1ab8b2b535f9ab672b2490c06d1116993a25e36c9219a7c6326040452bdbb misc/t-timer-object.pl
SHA256 24f511d67820204708ac297429be7ef33f58a63db06de5e7b849dba4b1473ac6 misc/t-tsp.pl
SHA256 3fbacdc88daad94c39c4ee8f2c1211c4f7021ab02b8a3a82913f36f43cf4f974 misc/t-useragent.pl
SHA256 16b64ff65593bbed47c7507127a39991758e2a552a9bfd53334acc015a66404b misc/t-variable-magic.pl
SHA256 963d16c4a00447b9778a3f63e8c44b6b2d365765d29dcb3987d89bc4552cb877 misc/t-viewstyle.pl
SHA256 a60c8ee45be71ed326a16c216e41705d187c0c9a121050e89e39de21e7624fee misc/t-volume-series.pl
SHA256 06438e1c71cec92c9527ccd850c45800e4364b4c23d4a43e6f52cf5ef8437840 misc/t-watchlist-model.pl
SHA256 fa4261f92dddb973db6eecfbba682ba2932fab7a3ea6cd5a19e14c516599550b misc/t-widget-disc.pl
SHA256 ed2bc868cb58120bd77e037d21c49cb41a020c481a4a0b0c155af999f36b81cf misc/t-widget-tracker.pl
devel/DownloadDialog.t view on Meta::CPAN
require Gtk2;
Gtk2->disable_setlocale; # leave LC_NUMERIC alone for version nums
my $have_display = Gtk2->init_check;
SKIP: {
$have_display or skip 'due to no DISPLAY available', 1;
{
my $dialog = App::Chart::Gtk2::DownloadDialog->new;
require Scalar::Util;
Scalar::Util::weaken ($dialog);
$dialog->destroy;
MyTestHelpers::main_iterations();
is ($dialog, undef, 'garbage collect after destroy');
}
}
#------------------------------------------------------------------------------
# Test::Weaken 3 for "contents"
my $have_test_weaken = eval "use Test::Weaken 3; 1";
if (! $have_test_weaken) { diag "Test::Weaken 3 not available -- $@"; }
# Test::Weaken::ExtraBits
my $have_test_weaken_extrabits = eval "use Test::Weaken::ExtraBits; 1";
if (! $have_test_weaken_extrabits) {
diag "Test::Weaken::ExtraBits not available -- $@";
}
sub my_ignore {
my ($ref) = @_;
return (Test::Weaken::ExtraBits::ignore_Class_Singleton($ref) # JobQueue
|| Test::Weaken::ExtraBits::ignore_global_functions($ref));
}
SKIP: {
$have_display
or skip 'due to no DISPLAY available', 1;
$have_test_weaken
or skip 'due to Test::Weaken 3 not available', 1;
$have_test_weaken_extrabits
or skip 'due to Test::Weaken::ExtraBits not available', 1;
require Test::Weaken::Gtk2;
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $dialog = App::Chart::Gtk2::DownloadDialog->new;
return $dialog;
},
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
devel/Main.t view on Meta::CPAN
require App::Chart::Gtk2::Main;
#-----------------------------------------------------------------------------
require Gtk2;
Gtk2->disable_setlocale; # leave LC_NUMERIC alone for version nums
my $have_display = Gtk2->init_check;
# Test::Weaken 3 for "contents"
my $have_test_weaken = eval "use Test::Weaken 3; 1";
if (! $have_test_weaken) {
diag "Test::Weaken 3 not available -- $@";
}
#-----------------------------------------------------------------------------
# actions (those which should always run at least)
SKIP: {
$have_display or skip 'due to no DISPLAY available', 15;
devel/Main.t view on Meta::CPAN
$action->activate;
}
$main->destroy;
foreach my $toplevel (Gtk2::Window->list_toplevels) {
$toplevel->destroy;
}
MyTestHelpers::main_iterations();
}
#-----------------------------------------------------------------------------
# weakening
require Scalar::Util;
sub my_ignore {
my ($ref) = @_;
return (Scalar::Util::blessed($ref)
&& $ref->isa('Glib::Flags'));
}
SKIP: {
$have_display or skip 'due to no DISPLAY available', 1;
$have_test_weaken or skip 'due to Test::Weaken 3 not available', 1;
require Test::Weaken::Gtk2;
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $main = App::Chart::Gtk2::Main->new;
return $main;
},
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
contents => \&Test::Weaken::Gtk2::contents_container,
devel/Main.t view on Meta::CPAN
}
foreach my $proberef (@$unfreed) {
diag " search $proberef";
MyTestHelpers::findrefs($proberef);
}
}
}
SKIP: {
$have_display or skip 'due to no DISPLAY available', 1;
$have_test_weaken or skip 'due to Test::Weaken 3 not available', 1;
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $main = App::Chart::Gtk2::Main->new;
$main->show_all;
return $main;
},
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
contents => \&Test::Weaken::Gtk2::contents_container,
});
is ($leaks, undef, 'Test::Weaken deep garbage collection -- with show_all');
if ($leaks) {
diag "Test-Weaken ", explain $leaks;
}
}
SKIP: {
$have_display or skip 'due to no DISPLAY available', 1;
$have_test_weaken or skip 'due to Test::Weaken 3 not available', 1;
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $main = App::Chart::Gtk2::Main->new;
$main->show_all;
$main->get_or_create_ticker;
$main->symbol_history;
return $main;
},
destructor => \&Test::Weaken::Gtk2::destructor_destroy,
devel/Main.t view on Meta::CPAN
# # print "main $main\n";
# $main->goto_next;
# $main->destroy;
#
# # my $c = Glib::Object::all_closures();
# # diag $c, scalar @$c;
# # my $d = $c->[0];
# # diag $d, scalar @$d;
#
# MyTestHelpers::main_iterations();
# Scalar::Util::weaken ($main);
# is ($main, undef,
# 'garbage collect after destroy -- after goto_next');
# MyTestHelpers::findrefs($main);
# }
# {
# my $leaks = Test::Weaken::leaks
# ({ constructor => sub {
# my $main = App::Chart::Gtk2::Main->new;
# $main->show_all;
devel/VacuumDialog.t view on Meta::CPAN
#------------------------------------------------------------------------------
SKIP: {
$have_display or skip 'due to no DISPLAY available', 2;
{
my $dialog = App::Chart::Gtk2::VacuumDialog->new;
$dialog->destroy;
require Scalar::Util;
Scalar::Util::weaken ($dialog);
MyTestHelpers::main_iterations();
is ($dialog, undef, 'garbage collect after destroy');
}
{
my $dialog = App::Chart::Gtk2::VacuumDialog->new;
$dialog->realize;
$dialog->destroy;
require Scalar::Util;
Scalar::Util::weaken ($dialog);
MyTestHelpers::main_iterations();
is ($dialog, undef, 'garbage collect after realize and destroy');
}
}
#------------------------------------------------------------------------------
# Test::Weaken 3 for "contents"
my $have_test_weaken = eval "use Test::Weaken 3; 1";
if (! $have_test_weaken) { diag "Test::Weaken 3 not available -- $@"; }
SKIP: {
($have_display && $have_test_weaken)
or skip 'due to no DISPLAY and/or no Test::Weaken available', 1;
require Test::Weaken::Gtk2;
my $leaks = Test::Weaken::leaks
({ constructor => sub {
my $dialog = App::Chart::Gtk2::VacuumDialog->new;
$dialog->realize;
return $dialog;
},
devel/run-download-dialog.pl view on Meta::CPAN
App::Chart::chart_dirbroadcast()->listen;
Gtk2->main;
exit 0;
}
{
my $dialog = App::Chart::Gtk2::DownloadDialog->new;
$dialog->destroy;
print Devel::FindRef::track ($dialog);
Scalar::Util::weaken ($dialog);
print defined $dialog ? "defined\n" : "not defined\n";
exit 0;
}
devel/run-raw-dialog.pl view on Meta::CPAN
my $symbol = $ARGV[0] || 'BHP.AX';
my $raw_dialog = App::Chart::Gtk2::RawDialog->popup ($symbol);
$raw_dialog->signal_connect (destroy => sub { Gtk2->main_quit; });
App::Chart::chart_dirbroadcast()->listen;
Gtk2->main;
$raw_dialog->destroy;
require Scalar::Util;
Scalar::Util::weaken ($raw_dialog);
if ($raw_dialog) {
say "$progname: oops, raw_dialog not finalized by weakening";
if (eval { require Devel::FindRef }) {
print Devel::FindRef::track($raw_dialog);
} else {
say "Devel::FindRef not available -- $@";
}
} else {
say "$progname: raw_dialog destroyed by weakening ok";
}
exit 0;
devel/run-watchlist.pl view on Meta::CPAN
my $watchlist = App::Chart::Gtk2::Ex::ToplevelBits::popup
('App::Chart::Gtk2::WatchlistDialog');
# connect to "unmap" here in case hide-on-delete, not destroy
$watchlist->signal_connect (unmap => sub { Gtk2->main_quit });
App::Chart::chart_dirbroadcast()->listen;
Gtk2->main;
$watchlist->destroy;
require Scalar::Util;
Scalar::Util::weaken ($watchlist);
if ($watchlist) {
say "$progname: oops, watchlist not finalized by weakening";
if (eval { require Devel::FindRef }) {
print Devel::FindRef::track($watchlist);
} else {
say "Devel::FindRef not available -- $@";
}
} else {
say "$progname: watchlist destroyed by weakening ok";
}
exit 0;
lib/App/Chart/Glib/Ex/DirBroadcast.pm view on Meta::CPAN
ref($self) or $self = $self->instance;
my $aref = ($self->{'connections'}->{$key} ||= []);
unshift @$aref, $subr;
}
sub connect_for_object {
my ($self, $key, $subr, $obj) = @_;
ref($self) or $self = $self->instance;
require Scalar::Util;
Scalar::Util::weaken ($obj);
my $csubr;
$csubr = sub {
if ($obj) {
$subr->($obj, @_);
} else {
_disconnect ($self, $key, $csubr);
}
};
$self->connect ($key, $csubr);
}
lib/App/Chart/Glib/Ex/DirBroadcast.pm view on Meta::CPAN
package App::Chart::Glib::Ex::DirBroadcast::Hold;
use strict;
use warnings;
sub new {
my ($class, $dirb) = @_;
my $self = bless { }, $class;
$self->{'target'} = $dirb;
require Scalar::Util;
Scalar::Util::weaken ($self->{'target'});
$dirb->{'hold'} ++;
return $self;
}
sub DESTROY {
my ($self) = @_;
my $dirb = delete $self->{'target'} || return;
if (-- $dirb->{'hold'}) { return; }
my $hold_list = $dirb->{'hold_list'};
lib/App/Chart/Glib/Ex/EmissionHook.pm view on Meta::CPAN
use Scalar::Util;
sub new {
my ($class, $target_class, $signal_name, $handler, @userdata) = @_;
my $self = bless { target_class => $target_class,
signal_name => $signal_name,
handler => $handler,
userdata => \@userdata,
}, $class;
my $weak_self = $self;
Scalar::Util::weaken ($weak_self);
$self->{'hook_id'} = $target_class->signal_add_emission_hook
($signal_name, \&_handler, \$weak_self);
return $self;
}
sub _handler {
my ($invocation_hint, $parameters, $ref_weak_self) = @_;
my $self = $$ref_weak_self || return 0; # disconnect
my $stay_connected = &{$self->{'handler'}}
($invocation_hint, $parameters, @{$self->{'userdata'}});
lib/App/Chart/Glib/Ex/MoreUtils.pm view on Meta::CPAN
use warnings;
use Glib;
use Scalar::Util;
use base 'Exporter';
our @EXPORT_OK = qw(ref_weak lang_select);
our %EXPORT_TAGS = (all => \@EXPORT_OK);
sub ref_weak {
my ($obj) = @_;
Scalar::Util::weaken ($obj);
return \$obj;
}
sub lang_select {
my %choices = @_;
my $default = $_[1];
foreach my $lang (Glib::get_language_names()) {
if (exists $choices{$lang}) {
return $choices{$lang};
lib/App/Chart/Glib/Ex/MoreUtils.pm view on Meta::CPAN
use App::Chart::Glib::Ex::MoreUtils;
=head1 FUNCTIONS
=over 4
=item C<< App::Chart::Glib::Ex::MoreUtils::ref_weak ($obj) >>
Return a reference to a weak reference to C<$obj>. This is good for the
"userdata" in signal connections etc when you want some weakening so you
don't keep C<$obj> alive forever due to the connection. For example,
$model->signal_connect (row_deleted, \&deleted_handler,
App::Chart::Glib::Ex::MoreUtils::ref_weak($self));
sub deleted_handler {
my ($model, $path, $ref_weak_self) = @_;
my $self = $$ref_weak_self || return;
...
}
lib/App/Chart/Glib/Ex/SignalBlock.pm view on Meta::CPAN
### SignalBlock on: "@pairs"
if ((@_ & 1) != 0) {
croak "SignalBlock expects even number of arguments for object,id pairs";
}
require Scalar::Util;
while (@_) {
my $object = shift @_;
my $id = shift @_;
$object->handler_block ($id);
push @$self, $object,$id;
Scalar::Util::weaken ($self->[-2]);
}
}
sub add_signalids {
my $self = shift;
while (@_) {
my $signalids = shift;
my $object = $signalids->object;
foreach my $id ($signalids->ids) {
$self->add ($object, $id);
}
}
}
sub DESTROY {
my ($self) = @_;
while (@$self) {
my $object = shift @$self;
my $id = shift @$self;
next if (! defined $object); # possible weakening
# could have been disconnected altogether by the application
if ($object->signal_handler_is_connected ($id)) {
### SignalBlock unblock: "$object" . "id=$id"
$object->handler_unblock ($id);
}
}
}
1;
lib/App/Chart/Glib/Ex/TieWeakNotify.pm view on Meta::CPAN
use Scalar::Util;
# uncomment this to run the ### lines
#use Smart::Comments;
my %instances;
sub set {
my ($class, $obj, $pname, $value) = @_;
if ($value) {
Scalar::Util::weaken ($obj->{$pname} = $value);
Scalar::Util::weaken ($instances{__PACKAGE__.'.'.$pname} = $value);
tie $instances{__PACKAGE__.'.'.$pname}, $class, $obj, $pname;
} else {
delete $instances{__PACKAGE__.'.'.$pname};
$obj->{$pname} = $value;
}
### $obj
}
sub TIESCALAR {
my ($class, $obj, $pname) = @_;
### TieWeakNotify TIESCALAR()
### $obj
### $pname
my $self = bless [ $obj, $pname ], $class;
Scalar::Util::weaken ($self->[0]);
return $self;
}
# Devel::FindBlessedRefs callback may end up fetching
sub FETCH {
my ($self) = @_;
return $self->[0];
# croak __PACKAGE__.' no FETCH allowed';
}
sub STORE {
my ($self, $value) = @_;
### TieWeakNotify STORE(): $value
if (! $value && (my $obj = $self->[0])) {
### weakened away
delete $instances{__PACKAGE__.'.'.$self->[1]};
$obj->notify ($self->[1]);
}
}
1;
__END__
# sub setup {
# my ($class, $obj, $pname, $initial_value) = @_;
lib/App/Chart/Glib/Ex/TieWeakNotify.pm view on Meta::CPAN
# 2 => 2 };
# if (@_ < 2) {
# croak 'TieWeakNotify expects object and propname';
# }
# if (@_ < 3) {
# $initial_value = $obj->get_property($pname);
# }
# if (ref ($self->[2] = $value)) {
# Scalar::Util::weaken ($self->[2]);
#
# # my $obj = $self->[0];
# # my $pname = $self->[1];
# # Scalar::Util::weaken ($obj->{$pname});
# }
=head1 NAME
App::Chart::Glib::Ex::TieWeakNotify -- notify signal from weakened property setting
=for test_synopsis my ($obj)
=head1 SYNOPSIS
use App::Chart::Glib::Ex::TieWeakNotify;
sub SET_PROPERTY {
my ($self, $pspec, $newval) = @_;
my $pname = $pspec->get_name;
lib/App/Chart/Gtk2/DownloadDialog.pm view on Meta::CPAN
my $messages_scrolled = Gtk2::ScrolledWindow->new();
$messages_scrolled->add($textview);
$messages_scrolled->set_policy('never', 'always');
$vbox->pack_start ($messages_scrolled, 1, 1, 0);
# During perl "global destruction" can have App::Chart::Gtk2::Job already
# destroyed enough that it has disconnected the message emission hook
# itself, leading to an unsightly Glib warning if attempting
# signal_remove_emission_hook() in our 'destroy' class closure. So
# instead leave it connected, with a weakened ref, and let it return 0 to
# disconnect itself on the next emission (if any).
#
# App::Chart::Gtk2::Job->signal_add_emission_hook
# (message => \&_do_job_message, App::Chart::Glib::Ex::MoreUtils::ref_weak ($self));
#
require App::Chart::Glib::Ex::EmissionHook;
$self->{'hook'} = App::Chart::Glib::Ex::EmissionHook->new
('App::Chart::Gtk2::Job',
message => \&_do_job_message,
App::Chart::Glib::Ex::MoreUtils::ref_weak($self));
lib/App/Chart/Gtk2/Ex/CellRendererTextBits.pm view on Meta::CPAN
use warnings;
# uncomment this to run the ### lines
#use Smart::Comments;
sub renderer_edited_set_value {
my ($renderer, $dest, $column_num) = @_;
defined $column_num or croak 'No column number supplied';
my @userdata = ($dest, $column_num);
require Scalar::Util;
Scalar::Util::weaken ($userdata[0]);
$renderer->signal_connect (edited => \&_renderer_edited_set_value_handler,
\@userdata);
}
sub _renderer_edited_set_value_handler {
my ($renderer, $pathstr, $newtext, $userdata) = @_;
my ($dest, $column_num) = @$userdata;
if ($dest->can('get_tree_view')) {
# on Gtk2::TreeViewColumn go to the Gtk2::TreeView
$dest = $dest->get_tree_view || croak 'No viewer from get_tree_view';
lib/App/Chart/Gtk2/Ex/GdkWindowTracker.pm view on Meta::CPAN
sub SET_PROPERTY {
my ($self, $pspec, $newval) = @_;
my $pname = $pspec->get_name;
if ($pname eq 'window') {
FINALIZE_INSTANCE ($self);
App::Chart::Glib::Ex::TieWeakNotify->set ($self, $pname, $newval);
if ($newval) {
Scalar::Util::weaken ($realized_instances{refaddr($self)} = $self);
$configure_event_hook_id ||= Gtk2::Window->signal_add_emission_hook
(configure_event => \&_do_configure_event);
}
}
}
sub _do_configure_event {
my ($invocation_hint, $parameters) = @_;
my $changed_window = $parameters->[0];
### configure event: $changed_window
foreach my $self (values %realized_instances) {
if (my $window = $self->{'window'}) {
if (_window_is_ancestor_or_self ($changed_window, $window)) {
$self->signal_emit ('moved');
}
} else {
# window weakened away
FINALIZE_INSTANCE ($self);
}
}
if (%realized_instances) {
return 1; # stay connected
} else {
### disconnect hook
undef $configure_event_hook_id;
return 0; # disconnect
}
lib/App/Chart/Gtk2/Ex/ListOfListsModel.pm view on Meta::CPAN
if (DEBUG) { print " mnum $mnum\n"; }
my $iter = $list_model->iter_nth_child (undef, $mnum) || last;
my $model = $list_model->get_value ($iter, 0);
$submodel ||= $model;
my $has_child = ($model && $model->iter_n_children(undef) != 0 ? 1 : 0);
my $minfo = { model => $model,
mnum => $mnum,
self => $self,
has_child => $has_child };
Scalar::Util::weaken ($minfo->{'self'});
push @mlist, $minfo;
if ($model) {
$minfo->{'ids'} = Glib::Ex::SignalIds->new
($model,
$model->signal_connect
(row_changed => \&_do_sublist_row_changed, $minfo),
$model->signal_connect
(row_deleted => \&_do_sublist_row_deleted, $minfo),
$model->signal_connect
lib/App/Chart/Gtk2/Ex/RadioGroup.pm view on Meta::CPAN
$object->set (group => undef);
delete $object->{__PACKAGE__.'.ids'};
my $members = $self->{'members'};
@$members = grep {defined && $_ != $object} @$members;
$self->notify ('members');
}
sub add {
my $self = shift;
my $members = $self->{'members'};
Scalar::Util::weaken (my $weak_self = $self);
while (@_) {
my $object = shift;
$object->set (group => $self->representative);
$object->{__PACKAGE__.'.ids'} = Glib::Ex::SignalIds->new
($object,
$object->signal_connect ('notify::group',
\&_do_group_changed, \$weak_self));
push @$members, $object;
Scalar::Util::weaken ($members->[-1]);
}
$self->notify ('members');
}
sub _do_group_changed {
my ($object, $pspec, $ref_weak_self) = @_;
my $self = $$ref_weak_self || return;
$self->remove ($object);
}
lib/App/Chart/Gtk2/Ex/TreeRowPosition.pm view on Meta::CPAN
my ($self, $pspec, $newval) = @_;
my $pname = $pspec->get_name;
### SET_PROPERTY: $pname, $newval
if ($pname eq 'path') {
### pathstr: $newval->to_string
$newval = $newval->copy;
} elsif ($pname eq 'model') {
FINALIZE_INSTANCE($self);
if ($newval) {
Scalar::Util::weaken ($newval->{__PACKAGE__.'.instances'}->{refaddr($self)} = $self);
$newval->{__PACKAGE__.'.ids'} ||= Glib::Ex::SignalIds->new
($newval,
$newval->signal_connect (row_changed => \&_do_row_changed),
$newval->signal_connect (row_deleted => \&_do_row_deleted),
$newval->signal_connect (row_inserted => \&_do_row_inserted),
$newval->signal_connect (rows_reordered => \&_do_rows_reordered));
}
}
$self->{$pname} = $newval;
lib/App/Chart/Gtk2/Ex/WidgetPointerGrab.pm view on Meta::CPAN
my $status = $window->pointer_grab
($window, $owner_events, $event_mask, $confine_to, $cursor, $time);
if ($status ne 'success') {
return $status;
}
my $self = bless { widget => $widget,
time => $time
}, $class;
require Scalar::Util;
Scalar::Util::weaken ($self->{'widget'});
require Glib::Ex::SignalIds;
$self->{'broken_id'} = Glib::Ex::SignalIds->new
($widget,
$widget->signal_connect ('grab_broken_event', \&_do_grab_broken,
App::Chart::Glib::Ex::MoreUtils::ref_weak($self)));
return $self;
}
lib/App/Chart/Gtk2/Ex/WidgetPositionTracker.pm view on Meta::CPAN
$widget->signal_connect (realize => \&_do_realize,
App::Chart::Glib::Ex::MoreUtils::ref_weak($self)));
### ids: $self->{'realize_ids'}
}
sub _do_realize {
my ($widget, $ref_weak_self) = @_;
### realize signal, window: $widget->window
my $self = $$ref_weak_self || return;
delete $self->{'realize_ids'};
Scalar::Util::weaken ($realized_instances{refaddr($self)} = $self);
$configure_event_hook_id ||= Gtk2::Widget->signal_add_emission_hook
(configure_event => \&_do_configure_event);
}
sub _do_configure_event {
my ($invocation_hint, $parameters) = @_;
my $changed_widget = $parameters->[0];
### configure event: $changed_widget
foreach my $self (values %realized_instances) {
lib/App/Chart/Gtk2/Ex/WidgetPositionTracker.pm view on Meta::CPAN
if ($changed_widget == $widget
|| $widget->is_ancestor ($changed_widget)) {
$self->signal_emit ('moved');
}
} else {
# was unrealized
FINALIZE_INSTANCE ($self);
_connect_realize ($self, $widget);
}
} else {
# widget weakened away
FINALIZE_INSTANCE ($self);
}
}
if (%realized_instances) {
return 1; # stay connected
} else {
### disconnect hook
undef $configure_event_hook_id;
return 0; # disconnect
}
lib/App/Chart/Gtk2/Ex/WidgetPositionTracker.pm view on Meta::CPAN
if (my $href = $widget->{(__PACKAGE__)}) {
delete $href->{refaddr($self)};
if (! %$href) {
delete $widget->{(__PACKAGE__)};
}
}
}
my $href = ($newval->{(__PACKAGE__)} ||= {});
$href->{refaddr($self)} = $self;
Scalar::Util::weaken ($href->{refaddr($self)});
my $changed_alloc = $parameters->[1];
my $alloc = $widget->allocation;
print $alloc->width, $changed_alloc->width,"\n";
sub _do_moved {
my ($widget, $allocation, $ref_weak_self) = @_;
my $self = $$ref_weak_self || return;
$self->signal_emit ('moved');
}
lib/App/Chart/Gtk2/IndicatorModel.pm view on Meta::CPAN
foreach my $elem (@$low) {
$self->set($self->append($low_iter),
COL_KEY, $elem->{'key'},
COL_NAME, $elem->{'name'},
COL_TYPE, $elem->{'type'},
COL_PRIORITY, $elem->{'priority'});
}
}
if (DEBUG) {
require Scalar::Util;
Scalar::Util::weaken ($aref);
if ($aref) {
die "Oops, IndicatorModelGenerated array not destroyed";
} else {
print "IndicatorModelGenerated array destroyed\n";
}
}
#--------------
# TA
lib/App/Chart/Gtk2/IndicatorModel.pm view on Meta::CPAN
return 1;
}
} while ($subiter = $model->iter_next($subiter));
return 0;
} else {
goto $visible_func;
}
};
require Scalar::Util;
$weak_wrapped_func = $wrapped_func;
Scalar::Util::weaken ($weak_wrapped_func);
return $wrapped_func;
}
1;
__END__
lib/App/Chart/Gtk2/IntradayDialog.pm view on Meta::CPAN
my $button = Gtk2::Button->new_with_label (__('Enter'));
$hbox->pack_start ($button, 0,0,0);
$button->signal_connect (clicked => \&_do_enter_button);
# During perl "global destruction" can have App::Chart::Gtk2::Job already
# destroyed enough that it has disconnected the message emission hook
# itself, leading to an unsightly Glib warning on attempting
# signal_remove_emission_hook() in our 'destroy' class closure.
#
# As a workaround instead leave it connected, with a weakened ref, and let
# it return 0 to disconnect itself on the next emission (if any).
#
# App::Chart::Gtk2::Job->signal_add_emission_hook
# ('status-changed', \&_do_job_status_changed,
# App::Chart::Glib::Ex::MoreUtils::ref_weak($self));
#
require App::Chart::Glib::Ex::EmissionHook;
$self->{'hook'} = App::Chart::Glib::Ex::EmissionHook->new
('App::Chart::Gtk2::Job',
status_changed => \&_do_job_status_changed,
lib/App/Chart/Gtk2/JobQueue.pm view on Meta::CPAN
my ($self) = @_;
require App::Chart::Gtk2::Job;
$self->set_column_types ('App::Chart::Gtk2::Job');
require App::Chart::Glib::Ex::EmissionHook;
$self->{'hook'} = App::Chart::Glib::Ex::EmissionHook->new
('App::Chart::Gtk2::Job',
status_changed => \&_do_job_status_changed,
App::Chart::Glib::Ex::MoreUtils::ref_weak($self));
# # Left connected until an emission notices the weakening so as to avoid
# # Glib warnings if we try to remove the hook if already removed during
# # "global destruction".
# App::Chart::Gtk2::Job->signal_add_emission_hook
# ('status_changed', \&_do_job_status_changed,
# App::Chart::Glib::Ex::MoreUtils::ref_weak($self));
}
sub _do_job_status_changed {
my ($invocation_hint, $param_list, $ref_weak_self) = @_;
### JobQueue _do_job_status_changed() ...
lib/App/Chart/Gtk2/JobStatusbarMessage.pm view on Meta::CPAN
'jobs',
'Arrayref of App::Chart::Gtk2::Job objects to display.',
Glib::G_PARAM_READWRITE)
];
# ENHANCE-ME: ConnectProperties onto the first in @$jobs, plus noticing when
# it and other jobs are done to remove from list
sub INIT_INSTANCE {
my ($self) = @_;
# disconnected in _do_job_status_changed() below when notice weakened away
# App::Chart::Gtk2::Job->signal_add_emission_hook
# ('status_changed',
# \&_do_job_status_changed,
# App::Chart::Glib::Ex::MoreUtils::ref_weak($self));
require App::Chart::Glib::Ex::EmissionHook;
$self->{'hook'} = App::Chart::Glib::Ex::EmissionHook->new
('App::Chart::Gtk2::Job',
status_changed => \&_do_job_status_changed,
App::Chart::Glib::Ex::MoreUtils::ref_weak($self));
lib/App/Chart/Gtk2/Symlist.pm view on Meta::CPAN
}
sub SET_PROPERTY {
my ($self, $pspec, $newval) = @_;
my $pname = $pspec->get_name;
$self->{$pname} = $newval;
if ($pname eq 'key') {
my $key = $newval;
$instances{$key} = $self;
# Scalar::Util::weaken ($instances{$key});
$self->set_property (where => { key => $key });
delete $self->{'name'};
}
}
sub FINALIZE_INSTANCE {
my ($self) = @_;
while (my ($key, $value) = each %instances) {
if (! defined $value || $value == $self) {
delete $instances{$key};
lib/App/Chart/Gtk2/Symlist.pm view on Meta::CPAN
my ($key) = @_;
if (my $self = $instances{$key}) { return $self; }
my $class = $key_to_class{$key} || 'App::Chart::Gtk2::Symlist::User';
require Module::Load;
Module::Load::load ($class);
my $self = $class->new (key => $key);
$instances{$key} = $self;
#
# can cause excess re-reading
# Scalar::Util::weaken ($instances{$key});
#
return $self;
}
sub all_lists {
my ($class) = @_;
require App::Chart::DBI;
my $dbh = App::Chart::DBI->instance;
my $sth = $dbh->prepare_cached('SELECT key FROM symlist ORDER BY seq ASC');
my $dbkeys = $dbh->selectcol_arrayref ($sth);
lib/App/Chart/Gtk2/Ticker.pm view on Meta::CPAN
my $all = App::Chart::Gtk2::Symlist::All->instance;
if (! $all->is_empty) {
$symlist = $all;
}
}
$self->set (symlist => $symlist);
}
sub FINALIZE_INSTANCE {
my ($self) = @_;
# Gtk2::Menu doesn't go away just by weakening if currently popped-up
# (because it's then a toplevel presumably); doing ->popdown() works, but
# ->destroy() seems the best idea
if (my $menu = $self->{'menu'}) {
$menu->destroy;
}
}
sub SET_PROPERTY {
my ($self, $pspec, $newval) = @_;
my $pname = $pspec->get_name;
lib/App/Chart/Gtk2/TickerMenu.pm view on Meta::CPAN
}
}
if ($pname eq 'ticker') {
$self->{'run_conn'} = $newval
&& Glib::Ex::ConnectProperties->new ([$newval,'run'],
[$self->{'run_item'},'active']);
$self->{'symlist_conn'} = $newval
&& Glib::Ex::ConnectProperties->new ([$newval, 'symlist'],
[$self->{'symlist_menu'}, 'symlist']);
Scalar::Util::weaken ($self->{$pname});
}
}
# 'activate' signal on Refresh menu item
sub _do_menu_refresh {
my ($menuitem) = @_;
my $self = $menuitem->get_parent || return;
my $ticker = $self->get('ticker') || return;
my $symlist = $ticker->get('symlist');
require App::Chart::Gtk2::Job::Latest;
lib/App/Chart/Gtk2/TickerMenu.pm view on Meta::CPAN
$main->goto_symbol ($self->{'symbol'}, $ticker && $ticker->get('symlist'));
$main->present;
}
# sub popup_from_ticker {
# my ($class_or_self, $event, $treeview) = @_;
# my $self = ref $class_or_self ? $class_or_self : $class_or_self->instance;
#
# my $watchlist = $treeview->get_toplevel;
# require Scalar::Util;
# Scalar::Util::weaken ($self->{'watchlist'} = $watchlist);
#
# my ($path) = $treeview->get_path_at_pos ($event->x, $event->y);
# if (! $path) { return; }
#
# my $model = $treeview->get_model; # App::Chart::Gtk2::WatchlistModel
# my $symlist = $model->get_symlist;
# my $iter = $symlist->get_iter ($path);
# my $symbol = $symlist->get_value ($iter, $model->COL_SYMBOL);
# $self->set (symbol => $symbol,
# symlist => $symlist);
lib/App/Chart/Gtk2/WatchlistSymbolMenu.pm view on Meta::CPAN
properties => { symbol => $self->get('symbol') },
screen => $self);
}
sub popup_from_treeview {
my ($class_or_self, $event, $treeview) = @_;
my $self = ref $class_or_self ? $class_or_self : $class_or_self->new;
my $watchlist = $treeview->get_toplevel;
require Scalar::Util;
Scalar::Util::weaken ($self->{'watchlist'} = $watchlist);
my ($path) = $treeview->get_path_at_pos ($event->x, $event->y);
if (! $path) { return; }
my $model = $treeview->get_model; # App::Chart::Gtk2::WatchlistModel
my $symlist = $model->get_symlist;
my $iter = $symlist->get_iter ($path);
my $symbol = $symlist->get_value ($iter, $model->COL_SYMBOL);
$self->set (symbol => $symbol,
symlist => $symlist);
lib/App/Chart/Series/Database.pm view on Meta::CPAN
use App::Chart::Database;
use App::Chart::DBI;
use base 'App::Chart::Series::OHLCVI';
our $VERSION = 275;
use constant DEBUG => 0;
# %cache is keyed by symbol string, with value a App::Chart::Series::Database
# object. The value reference is weakened so it becomes undef when
# otherwise unused.
#
our %cache = ();
sub _purge_cache_on_data_changed {
my ($symbol_hash) = @_;
if (DEBUG) {
print "data-changed, purge series: ",
join (', ', grep {exists $cache{$_}} keys %$symbol_hash),"\n";
}
lib/App/Chart/Series/Database.pm view on Meta::CPAN
$self = $class->SUPER::new (symbol => $symbol,
timebase => $timebase);
# lose any cache entries which have gone undef through weaks destroyed
delete @cache{grep {! $cache{$_}} keys %cache};
# add new entry
_init_cache();
$cache{$symbol} = $self;
Scalar::Util::weaken ($cache{$symbol});
return $self;
}
sub hi {
my ($self) = @_;
if (! exists $self->{'hi'}) {
if (DEBUG) { print "Series hi for $self->{'symbol'}\n"; }
my $date = App::Chart::DBI->read_single
('SELECT date FROM daily WHERE symbol=? ORDER BY date DESC LIMIT 1',