The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Silki::Role::CLI::HasOptionalProcess;
{
  $Silki::Role::CLI::HasOptionalProcess::VERSION = '0.29';
}

use strict;
use warnings;
use namespace::autoclean;

use Silki::Schema::Process;
use Silki::Types qw( Str );

use Moose::Role;
use Moose::Util::TypeConstraints;

requires qw( _run _final_result_string _print_success_message );

{
    subtype 'Process', as 'Silki::Schema::Process';
    coerce 'Process',
        from Str,
        via { Silki::Schema::Process->new( process_id => $_ ) };

    MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
        'Process' => '=s' );

    has process => (
        is     => 'ro',
        isa    => 'Process',
        coerce => 1,
        documentation =>
            'A process id. If given, this process is updated instead of sending output to the console',
    );
}

sub run {
    my $self = shift;

    $self->process()->update(
        status     => 'Starting work',
        system_pid => $$,
    ) if $self->process();

    my @results = eval { $self->_run() };

    if ( my $e = $@ ) {
        $self->_handle_error($e);
    }
    else {
        $self->_handle_success(@results);
    }
}

sub _log_coderef {
    my $self = shift;

    if ( $self->process() ) {
        my $process = $self->process();

        return sub { $process->update( status => join '', @_ ) };
    }
    else {
        return sub { print q{  }, @_, "\n" };
    }
}

sub _handle_error {
    my $self  = shift;
    my $error = shift;

    if ( $self->process() ) {
        $self->process()->update(
            status      => "Error doing work: $error",
            is_complete => 1,
        );
    }
    else {
        die $error;
    }

    exit 1;
}

sub _handle_success {
    my $self = shift;

    if ( $self->process() ) {
        $self->process()->update(
            status         => 'Completed work',
            is_complete    => 1,
            was_successful => 1,
            final_result   => $self->_final_result_string(@_),
        );
    }
    else {
        $self->_print_success_message(@_);
    }

    exit 0;
}

if ( eval "use Getopt::Long::Descriptive; 1;"
    && Getopt::Long::Descriptive->VERSION < 0.087 ) {
    eval <<'EOF';
{
package
    Getopt::Long::Descriptive::Usage;
no warnings 'redefine';

sub option_text {
  my ($self) = @_;

  my @options  = @{ $self->{options} || [] };
  my $string   = q{};

  # a spec can grow up to 4 characters in usage output:
  # '-' on short option, ' ' between short and long, '--' on long
  my @specs = map { $_->{spec} } grep { $_->{desc} ne 'spacer' } @options;
  my $length   = (max(map { length } @specs) || 0) + 4;
  my $spec_fmt = "\t%-${length}s";

  while (@options) {
    my $opt  = shift @options;
    my $spec = $opt->{spec};
    my $desc = $opt->{desc};
    if ($desc eq 'spacer') {
      $string .= sprintf "$spec_fmt\n", $opt->{spec};
      next;
    }

    $spec = Getopt::Long::Descriptive->_strip_assignment($spec);
    $spec = join " ", reverse map { length > 1 ? "--$_" : "-$_" }
                              split /\|/, $spec;

    my @desc = $self->_split_description($length, $desc);

    $string .= sprintf "$spec_fmt  %s\n", $spec, shift @desc;
    for my $line (@desc) {
        $string .= "\t";
        $string .= q{ } x ( $length + 2 );
        $string .= "$line\n";
    }
  }

  return $string;
}

sub _split_description {
  my ($self, $length, $desc) = @_;

  # 8 for a tab, 2 for the space between option & desc;
  my $max_length = 78 - ( $length + 8 + 2 );

  return $desc if length $desc <= $max_length;

  my @lines;
  while (length $desc > $max_length) {
    my $idx = rindex( substr( $desc, 0, $max_length ), q{ }, );
    push @lines, substr($desc, 0, $idx);
    substr($desc, 0, $idx + 1) = q{};
  }
  push @lines, $desc;

  return @lines;
}
}
EOF
}

1;