view release on metacpan or  search on metacpan

lib/App/RecordStream/Operation.pm  view on Meta::CPAN

  };
}

# this is a hook for subclasses
sub add_help_types {
}

sub use_help_type {
  my $this = shift;
  my $type = shift;

  $this->{'HELP_TYPES'}->{$type}->{'USE'} = 1;
  $this->{'HELP_TYPES'}->{'all'}->{'USE'} = 1;
}

sub add_help_type {
  my $this        = shift;
  my $type        = shift;
  my $action      = shift;
  my $description = shift;
  my $skip_in_all = shift;
  my $option_name = shift || 0;

  $this->{'HELP_TYPES'}->{$type} = {
    USE         => 1,
    SKIP_IN_ALL => $skip_in_all,
    CODE        => $action,
    OPTION_NAME => $option_name,
    DESCRIPTION => $description,
  };
}

sub parse_options {
  my $this                  = shift;
  my $args                  = shift || [];
  my $options_spec          = shift || {};
  my $configuration_options = shift || [];

  # Add help options
  foreach my $help_type (keys %{$this->{'HELP_TYPES'}}) {
    my $type_info = $this->{'HELP_TYPES'}->{$help_type};
    next unless ( $type_info->{'USE'} );

    my $help_option = $type_info->{'OPTION_NAME'} || 'help-' . $help_type;

    $options_spec->{$help_option} ||= sub {
      $type_info->{'CODE'}->($this);
      exit 1;
    };
  }

  # Add filename annotation option
  $options_spec->{'--filename-key|fk=s'} = \($this->{'FILENAME_KEY'})
    if $this->does_record_output;

  my $starting_config = Getopt::Long::Configure();

  # Push custom configuration
  Getopt::Long::Configure('no_ignore_case', @$configuration_options);

  local @ARGV = @$args;
  unless (GetOptions(%$options_spec)) {
    # output usage if there was a problem with option parsing
    $this->_set_wants_help(1);
  }

  # Restore original configuration
  Getopt::Long::Configure($starting_config);

  @$args = @ARGV;
}

sub update_current_filename {
  my ($this, $filename) = @_;
  set_current_filename($filename);
}

sub _set_wants_help {
  my $this = shift;
  my $help = shift;

  $this->{'WANTS_HELP'} = $help;
}

sub get_wants_help {
  my $this = shift;
  return $this->{'WANTS_HELP'};
}

sub _set_exit_value {
  my $this  = shift;
  my $value = shift;

  $this->{'EXIT_VALUE'} = $value;
}

sub get_exit_value {
  my $this = shift;
  return $this->{'EXIT_VALUE'} || 0;
}

sub print_usage {
  my $this    = shift;
  my $message = shift;

  if ( $message ) {
    chomp $message;
    warn "$message\n";

    if ( $message =~ m/FATAL/ ) {
      return;
    }
  }

  my $usage = $this->usage();

  #Remove all trailing newlines
  while (chomp $usage > 0) {}

  my $formatted_usage = $this->format_usage($usage);