view release on metacpan or  search on metacpan

lib/App/CLI/Plugin/Proc/PID/File.pm  view on Meta::CPAN

package App::CLI::Plugin::Proc::PID::File;

=pod

=head1 NAME

App::CLI::Plugin::Proc::PID::File - for App::CLI::Extension pidfile plugin module

=head1 VERSION

1.3

=head1 SYNOPSIS

  # MyApp.pm
  package MyApp;
  
  use strict;
  use base qw(App::CLI::Extension);
  
  # extension method
  __PACKAGE__->load_plugins(qw(Proc::PID::File));
  
  # extension method
  __PACKAGE__->config( proc_pid_file => { verify => 1, dir => "/var/run", name => "myapp" } );
  
  1;
  
  # MyApp/Hello.pm
  package MyApp::Hello;
  use strict;
  use feature ":5.10.0";
  use base qw(App::CLI::Command);
  
  sub run {
  
      my($self, @args) = @_;
      # make pid file (/var/run/myapp.pid)
      # /var/run/myapp.pid is automatically deleted (by Proc::PID::File::DESTROY)
      $self->pf->touch;
  }

=head1 DESCRIPTION

App::CLI::Extension pidfile plugin module

pf method setting

  __PACKAGE__->config( proc_pid_file => {%proc_pid_file_option} );

Proc::PID::File option is L<Proc::PID::File> please refer to

=cut

use strict;
use warnings;
use base qw(Class::Accessor::Grouped);
use Fcntl qw(:DEFAULT :flock);
use File::Basename;
use File::Path;
use Proc::PID::File;

__PACKAGE__->mk_group_accessors(inherited => "pf");
our $VERSION = '1.3';
our $PROC_PID_FILE_RECOMENDED_VERSION = '1.37';

=pod

=head1 EXTENDED METHOD

=head2 Proc::PID::File::path

return pidfile path

Example:

  # MyApp::Hello(App::CLI::Command base package)
  sub run {

      my($self, @args) = @_;
      say $self->pf->path;
  }

=cut

lib/App/CLI/Plugin/Proc/PID/File.pm  view on Meta::CPAN

                           # name  => "myapp"
                  }
             );

Example2. pidfile option

  myapp --pidfile=/tmp/myapp.pid

=cut

sub setup {

	my($self, @argv) = @_;
	my $pidfile;
    my %option = (exists $self->config->{proc_pid_file}) ? %{$self->config->{proc_pid_file}} : ();
	if (exists $option{pidfile} && defined $option{pidfile}) {
		$pidfile = $option{pidfile};
	}
	if (exists $self->{pidfile} && defined $self->{pidfile}) {
		$pidfile = $self->{pidfile};
	}

	if (defined $pidfile) {
		# get name and path. fileparse is File::Basename function
		my($name, $path) = fileparse($pidfile, qr/\.[^.]*$/);
		$option{name} = $name;
		$option{dir}  = $path;
	}

	# make directory. mkpath is File::Path function
	if (exists $option{dir} && !-d $option{dir}) {
		mkpath($option{dir});
	}

	$self->pf(Proc::PID::File->new(%option));
	$self->maybe::next::method(@argv);
}

####################################
# Proc::PID::File extended method
####################################
sub _path {

	my $self = shift;
	return $self->{path};
}

sub _alive {

	my $self = shift;
	$self->debug("alive(): for A::C::P::Proc::PID::File compat method");
	my $pid = $self->read;
	if (defined $pid) {
		$self->debug("alive(): $pid");
	} else {
		$self->debug("alive(): not living my process");
		return 0;
	}

	if ($pid != $$ && kill(0, $pid)) {
		return $self->verify($pid) ? 1 : 0;
	}
	return 0;
}

sub _read {

	my $self = shift;
	$self->debug("read(): for A::C::P::Proc::PID::File compat method");
	if (!-e $self->path) {
		return;
	}
	open my $fh, "<", $self->path or die "can not open file ". $self->path . ": $!";
	flock $fh, LOCK_EX | LOCK_NB  or die "can not flock file " . $self->path . ": $!";
	my($pid) = <$fh> =~ /^(\d{1,})$/; 
	close $fh or die "can not close file " . $self->path . ": $!";

	$self->debug(sprintf "read(%s) = $pid", $self->path);
	return $pid;
}

sub _touch {

	my $self = shift;
	$self->debug("touch(): for A::C::P::Proc::PID::File compat method");
	$self->debug("write($$)");
	open my $fh, ">", $self->path or die "can not open file ". $self->path . ": $!";
	flock $fh, LOCK_EX | LOCK_NB  or die "can not flock file " . $self->path . ": $!";
	print $fh "$$\n";
	close $fh or die "can not close file " . $self->path . ": $!";
}


1;
__END__

=head1 TIPS

=head2 Multi Launcher Lock Plugin

1. Make MultiBoot Lock Plugin

Example

  package MyApp::Plugin::MultiLauncherLock;
  
  use strict;
  use feature ":5.10.0";
  
  sub prerun {
  
      my($self, @argv) = @_;
  
      if ($self->pf->alive) {
          my $pid = $self->pf->read;
          die "already " . $self->argv0 . "[$pid] is running";
      }
      $self->pf->touch;
      $self->maybe::next::method(@argv);
  }