| Form-Factory documentation | Contained in the Form-Factory distribution. |
Form::Factory::Interface::CLI - Command-line interface builder for form factory
version 0.020
#/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;
}
Provides a simple interface for building command-line tools that manipulate actions.
This is a subroutine responsible for returning the usage parameters back to the user. The default prints to STDOUT.
This is a subroutine responsible for return a list of command-line arguments. The default implementation returns a reference to @ARGV.
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.
Prints a usage line for each control.
Consumes the command-line arguments and files specified on the command-line to fill in the action.
Andrew Sterling Hanenkamp <hanenkamp@cpan.org>
Copyright 2009 Qubling Software LLC.
This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself.
| 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;