view release on metacpan or  search on metacpan

lib/App/Chart/Gtk2/JobQueue.pm  view on Meta::CPAN

# FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
# details.
#
# You should have received a copy of the GNU General Public License along
# with Chart.  If not, see <http://www.gnu.org/licenses/>.

package App::Chart::Gtk2::JobQueue;
use 5.010;
use strict;
use warnings;
use Carp;
use Gtk2;
use Gtk2::Ex::TreeModelBits;

use App::Chart::Glib::Ex::MoreUtils;
use App::Chart;

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

use constant DEBUG => 0;

use Glib::Object::Subclass
  'Gtk2::ListStore';

use Class::Singleton 1.03; # 1.03 for _new_instance()
use base 'Class::Singleton';
*_new_instance = \&Glib::Object::new;


# Had some trouble during program exit with Job 'status-changed' emissions
# reaching our _do_job_status_changed() after we have been DESTROY'ed.  This
# must be late in exit since the singleton keeps us alive globally.  But
# it's not at global destruction, according to Devel::GlobalDestruction.
#
# In any case an explicit disconnect of $self->{'hook'} stops the emission.
#
# Normally DESTROY is wrong for Glib::Object subclasses since it's called
# variously when the object loses its last Perl reference but not last C
# reference, or something like that.  But here as a global the last Perl
# reference means program exit.
#
sub DESTROY {
  my ($self) = @_;
  ### JobQueue DESTROY() ...
  undef $self->{'hook'};
  $self->SUPER::DESTROY;
}

sub INIT_INSTANCE {
  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() ...

  my ($job) = @$param_list;
  my $self = $$ref_weak_self || return 0; # disconnect
  return if $self->{'destroyed'};

  $self->foreach (sub {
                    my ($self, $path, $iter) = @_;
                    my $j = $self->get_value($iter,0);
                    if ($j == $job) {
                      $self->row_changed ($path, $iter);
                    }
                  });
  return 1; # stay connected
}

sub enqueue {
  my ($self, $job) = @_;
  ref $self or $self = $self->instance;
  $job->isa('App::Chart::Gtk2::Job') or croak "JobQueue: not a job object: $job";

  my $pos = $self->iter_n_children(undef) - 1;
  for ( ; $pos >= 0; $pos--) {
    my $j = $self->get_value ($self->iter_nth_child(undef,$pos), 0);
    if ($j->priority >= $job->priority) {
      last;
    }
  }
  $self->insert_with_values ($pos+1, 0 => $job);
  $self->consider_run ($job);
}

sub consider_run {
  my ($self, $new_job) = @_;
  ref $self or $self = $self->instance;
  my $job = List::Util::first { ! $_->get('done') && ! $_->get('subprocess') }
    $self->all_jobs;
  if (DEBUG) { print "JobQueue next to run ",$job//'undef',"\n"; }

  if ($job) {
    require App::Chart::Gtk2::Subprocess;
    if (my $proc = App::Chart::Gtk2::Subprocess->find_idle) {
      $proc->start_job ($job);
      if ($new_job && $job == $new_job) {
        $new_job = undef;
      }
    }
  }
  if ($new_job) {
    $new_job->set (status => 'Waiting');
  }