Form::Factory::Interface::CLI - Command-line interface builder for form factory


Form-Factory documentation Contained in the Form-Factory distribution.

Index


Code Index:

NAME

Top

Form::Factory::Interface::CLI - Command-line interface builder for form factory

VERSION

Top

version 0.020

SYNOPSIS

Top

  #/usr/bin/perl
  use strict;
  use warnings;

  use Form::Factory;

  my $cli = Form::Factory->new_interface('CLI');
  my $action = $cli->new_action(shift @ARGV);

  $action->consume_and_clean_and_check_and_process;

  if ($action->is_valid and $action->is_success) {
      print "done.\n";
  }
  else {
      my $messages = $action->results->all_messages;
      print $messages;
      print "usage: $0 OPTIONS\n\n";
      print "Options:\n";
      $action->render;
  }

DESCRIPTION

Top

Provides a simple interface for building command-line tools that manipulate actions.

ATTRIBUTES

Top

renderer

This is a subroutine responsible for returning the usage parameters back to the user. The default prints to STDOUT.

get_args

This is a subroutine responsible for return a list of command-line arguments. The default implementation returns a reference to @ARGV.

get_file

This is a subroutine responsible for returning the contents of files used on the command-line. It is passed the interface object and then the name of the file to load. The default implementation slurps up the named file or, in the case of the name begin "-", returns the contents of STDIN.

METHODS

Top

render_control

Prints a usage line for each control.

consume_control

Consumes the command-line arguments and files specified on the command-line to fill in the action.

AUTHOR

Top

Andrew Sterling Hanenkamp <hanenkamp@cpan.org>

COPYRIGHT AND LICENSE

Top


Form-Factory documentation Contained in the Form-Factory distribution.
package Form::Factory::Interface::CLI;
BEGIN {
  $Form::Factory::Interface::CLI::VERSION = '0.020';
}
use Moose;

with qw( Form::Factory::Interface );

use Carp ();

has renderer => (
    is        => 'ro',
    isa       => 'CodeRef',
    required  => 1,
    default   => sub { sub { print @_ } },
);

has get_args => (
    is        => 'ro',
    isa       => 'CodeRef',
    required  => 1,
    default   => sub { sub { \@ARGV } },
);

has get_file => (
    is        => 'ro',
    isa       => 'CodeRef',
    required  => 1,
    default   => sub { 
        sub { 
            my ($interface, $name) = @_;
            my $fh;

            if ($name eq '-') {
                $fh = \*STDIN;
            }
            else {
                open $fh, '<', $name or Carp::croak("cannot read $name: $!\n");
            }

            do { local $/; <$fh> };
        }
    },
);

sub render_control {
    my ($self, $control, %options) = @_;

    return if $control->does('Form::Factory::Control::Role::HiddenValue');

    my $arg;
    if ($control->does('Form::Factory::Control::Role::AvailableChoices')) {
        my @values = map { $_->value } @{ $control->available_choices };
        $arg = '[ ' . join(' | ', @values) . ' ]';
    }
    elsif ($control->does('Form::Factory::Control::Role::BooleanValue')) {
        $arg = ''
    }
    elsif ($control->does('Form::Factory::Control::Role::PresetValue')) {
        $arg = '';
    }
    elsif ($control->does('Form::Factory::Control::Role::MultiLine')) {
        $arg = 'FILE';
    }
    else {
        $arg = 'TEXT';
    }

    my $description = $control->documentation || '';

    $self->renderer->($self,
        sprintf("    --%-20s %s\n", $control->name . ' '. $arg, $description)
    );
}

sub consume_control {
    my ($self, $control, %options) = @_;

    my @argv = @{ $self->get_args->($self) };
    my ($fetch, @values);
    for my $argv (@argv) {
        if ($fetch) {
            push @values, $argv;
            undef $fetch;
        }

        elsif ($argv eq '--' . $control->name) {
            if ($control->does('Form::Factory::Control::Role::BooleanValue')) {
                push @values, $control->true_value;
            }
            else {
                $fetch++;
            }
        }
    }

    return {} unless @values > 0;

    my $get_value = sub {
        my $value = shift;
        if ($control->does('Form::Factory::Control::Role::MultiLine')) {
            return $self->get_file->($self, $value);
        }
        else {
            return $value;
        }
    };

    if ($control->does('Form::Factory::Control::Role::ListValue')) {
        my @result;
        push @result, $get_value->($_) for @values;
        $control->current_values(\@result);
    }

    else {
        Carp::croak(sprintf("the --%s option should be used only once\n", $control->name))
            if @values > 1;
     
        $control->current_value($get_value->($values[0]));
    }
}

1;