view release on metacpan or  search on metacpan

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

  ### Subprocess INIT_INSTANCE()

  $self->{'status'} = DEFAULT_STATUS;
  liststore_append_with_values ($store, 0 => $self);

  # or maybe $^X for '/usr/bin/perl' and $0 for 'chart', except that bombs
  # badly if being run from a script
  my @cmd = ('chart', '--subprocess');
  if ($App::Chart::option{'verbose'}) { push @cmd, '--verbose' }

  require IO::Socket;
  my ($sock_child, $sock_parent) = IO::Socket->socketpair
    (Socket::AF_UNIX(), Socket::SOCK_STREAM(), 0);

  ### @cmd
  require Proc::SyncExec;
  my $pid = Proc::SyncExec::sync_exec
    (sub {
       my $fd = $sock_child->fileno;
       return POSIX::dup2 ($fd, 0) != -1
         &&   POSIX::dup2 ($fd, 1) != -1
           && POSIX::dup2 ($fd, 2) != -1;
     }, @cmd);
  #     }, '/bin/sh', '-c', 'echo hi 1>&2; sleep 5; echo bye');
  if (! defined $pid) {
    my $err = Glib::strerror ($!);
    my $status = $self->{'status'}
      = __x('Cannot start subprocess: {strerror}', strerror => $err);
    $self->message ("$status\n");
    return;
  }
  require App::Chart::Proc::ChildPid;
  $self->{'pidobj'} = App::Chart::Proc::ChildPid->new ($pid);

  $sock_child->close;
  $sock_parent->blocking(0);
  ### self: "$self"
  ### $pid
  ### reader fd: $sock_parent->fileno

  require PerlIO::via::EscStatus::Parser;
  $self->{'status_parser'} = PerlIO::via::EscStatus::Parser->new;
  $self->{'sock'} = $sock_parent;
  $self->{'io_watch'} = Glib::Ex::SourceIds->new
    (Glib::IO->add_watch ($sock_parent->fileno, ['in', 'hup', 'err'],
                          \&_do_read, App::Chart::Glib::Ex::MoreUtils::ref_weak($self)));
}

sub FINALIZE_INSTANCE {
  my ($self) = @_;
  ### Subprocess FINALIZE_INSTANCE()
  $self->stop;
}

sub SET_PROPERTY {
  my ($self, $pspec, $newval) = @_;
  my $pname = $pspec->get_name;
  $self->{$pname} = $newval;  # per default GET_PROPERTY

  if ($pname eq 'job') {
    _update_idle_timer ($self);
  }
}

# 'notify' signal class closure
sub _do_notify {
  my ($self, $pspec) = @_;
  ### Subprocess notify: $pspec->get_name
  $self->signal_chain_from_overridden ($pspec);

  # emit 'status-changed' under notify so it's held up by freeze_notify
  if ($pspec->get_name eq 'status') {
    $self->signal_emit ('status-changed', $self->{'status'});
    _emit_row_changed ($self);
  }
}

sub pid {
  my ($self) = @_;
  my $pidobj = $self->{'pidobj'};
  return $pidobj && $pidobj->pid;
}

sub message {
  my ($self, $str) = @_;
  if (my $job = $self->{'job'}) {
    $job->message ($str);
  } else {
    print $str;
  }
}

sub start_job {
  my ($self, $job) = @_;
  ### Subprocess start_job(): "$job"
  {
    my $freezer = Glib::Ex::FreezeNotify->new ($self, $job);
    $job->set (subprocess => $self);
    $self->set (job => $job);

    my $fh = $self->{'sock'};
    if ($fh) {
      $job->set(status => __('Starting'));
      $self->set (status => __x('Running job: {name}',
                                name => $job->get('name')));
      undef $freezer;
      require Storable;
      my $data = Storable::freeze ($job->get('args'));
      print $fh length($data),"\n",$data;
      $fh->flush;
    } else {
      _unset_job ($self, $self->{'status'}, $self->{'status'});
    }
  }
}

sub status {
  my ($self) = @_;
  return $self->{'status'};
}

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

              status => $self_status);
}

sub stop {
  my ($self) = @_;
  ### Subprocess stop()
  delete $self->{'io_watch'};
  delete $self->{'sock'};
  delete $self->{'pidobj'};
  _unset_job ($self, undef, __('Stopped'));
}

sub _do_read {
  my ($fd, $conditions, $ref_weak_self) = @_;
  my $self = $$ref_weak_self || return Glib::SOURCE_REMOVE;
  #### Subprocess read: "$self"
  my $sock = $self->{'sock'};
  my $status = undef;

  for (;;) {
    my $buf;
    my $len = $sock->sysread ($buf, 8192);
    #### got: $len
    ### $!

    if (! $len) {
      if (! defined $len) {
        if ($! == EWOULDBLOCK) { last; }  # no more data for now
        my $errmsg = Glib::strerror ($!);
        $self->message ("Subprocess read error: $errmsg\n");
        $status = __('Read error');
      } else {
        # end of file, child closed pipe
        $status = __('Died');
      }
      delete $self->{'io_watch'};
      delete $self->{'sock'};
      delete $self->{'pidobj'};
      _unset_job ($self, $status, $status);
      return Glib::SOURCE_REMOVE;
    }

    my ($new_status, $message) = $self->{'status_parser'}->parse($buf);
    $self->message ($message);
    if (defined $new_status) { $status = $new_status; }
  }

  if (defined $status) {
    if ($status eq 'Idle') {
      _unset_job ($self, __('Done'), __('Idle'));
      App::Chart::Gtk2::JobQueue->consider_run;
    } else {
      if (my $job = $self->{'job'}) {
        $job->set (status => $status);
      }
    }
  }
  return Glib::SOURCE_CONTINUE;
}

sub _update_idle_timer {
  my ($self) = @_;
  my $want_timer = ($self->pid && ! $self->{'job'});

  if ($want_timer) {
    $self->{'timer_ids'} ||= Glib::Ex::SourceIds->new
      (Glib::Timeout->add (IDLE_TIMEOUT_SECONDS * 1000,
                           \&_do_idle_timeout,
                           App::Chart::Glib::Ex::MoreUtils::ref_weak($self)));
  } else {
    $self->{'timer_ids'} = undef;
  }
}

sub _do_idle_timeout {
  my ($ref_weak_self) = @_;
  my $self = $$ref_weak_self || return Glib::SOURCE_REMOVE;
  $self->stop;

  Gtk2::Ex::TreeModelBits::remove_matching_rows
      ($store, sub { my ($store, $iter) = @_;
                     $store->get_value($iter,0) == $self });

  $self->{'timer_ids'} = undef;
  return Glib::SOURCE_REMOVE;
}

# send out a 'row-changed' on the global $store for subprocesses $self
sub _emit_row_changed {
  my ($self) = @_;
  $store->foreach (sub {
                     my ($store, $path, $iter) = @_;
                     my $this = $store->get_value ($iter, 0);
                     if ($this && $this == $self) {
                       $store->row_changed ($path, $iter);
                     }
                   });
}

sub all_subprocesses {
  my ($class) = @_;
  return Gtk2::Ex::TreeModelBits::column_contents ($store, 0);
}

sub remove_done {
  my ($class) = @_;
  Gtk2::Ex::TreeModelBits::remove_matching_rows
      ($store, sub { my ($store, $iter) = @_;
                     my $proc = $store->get_value ($iter, 0);
                     return ! $proc->pid;
                   });
}

#------------------------------------------------------------------------------
# generic helpers

sub liststore_append_with_values {
  my $store = shift;
  $store->insert_with_values ($store->iter_n_children(undef), @_);
}


1;
__END__

=for stopwords subprocess Storable stdout EINTR undef

=head1 NAME

App::Chart::Gtk2::Subprocess -- child process to run jobs

=head1 SYNOPSIS

 use App::Chart::Gtk2::Subprocess;
 my $subprocess = App::Chart::Gtk2::Subprocess->new;

=head1 DESCRIPTION

A C<App::Chart::Gtk2::Subprocess> is a child sub-process running C<chart
--subprocess>.  That subprocess reads tasks from its standard input (in a
length-delimited "Storable" format) and prints messages and
C<PerlIO::via::EscStatus> status strings to its stdout.  The
C<App::Chart::Gtk2::Subprocess> sends a C<App::Chart::Gtk2::Job> task to the subprocess
then reads its output.