App-SimpleScan

 view release on metacpan or  search on metacpan

lib/App/SimpleScan.pm  view on Meta::CPAN

package App::SimpleScan;

use warnings;
use strict;
use English qw(-no_match_vars);

our $VERSION = '4.0.1';

use Carp;
use Getopt::Long;
use Regexp::Common;
use Scalar::Util qw(blessed);
use WWW::Mechanize;
use WWW::Mechanize::Pluggable;
use Test::WWW::Simple;
use App::SimpleScan::TestSpec;
use App::SimpleScan::Substitution;
use Graph;

use Module::Pluggable search_path => [qw(App::SimpleScan::Plugin)];

use base qw(Class::Accessor);
__PACKAGE__->mk_accessors(qw(sub_engine tests test_count
                             next_line_callbacks _deps));

$|++;                                                   ##no critic

use App::SimpleScan::TestSpec;

my $reference_mech = WWW::Mechanize::Pluggable->new;
my $sub_engine     = App::SimpleScan::Substitution->new;

my @local_pragma_support =
  (
    ['agent'   => \&_do_agent],
    ['nocache'   => \&_do_nocache],
    ['cache'   => \&_do_cache],
  );

# Variables and setup for basic command-line options.
my($generate, $run, $warn, $override, $defer, $debug);
my($cache_from_cmdline, $no_agent);
my($run_status);

# Option-to-variable mappings for Getopt::Long
my %basic_options =
  ('generate'  => \$generate,
   'run'       => \$run,
   'warn'      => \$warn,
   'override'  => \$override,
   'defer'     => \$defer,
   'debug'     => \$debug,
   'autocache' => \$cache_from_cmdline,
   'no-agent'  => \$no_agent,
   'status'    => \$run_status,
  );

use base qw(Class::Accessor::Fast);

# Patterns to extract <variables> or >variables< from a string.
my $out_angled;
$out_angled = qr/ < ( [^<>] | (??{$out_angled}) )* > /x;
                  # open angle-bracket then ...
                      # non-angle chars ...
                            # or ...
                               # another angle-bracketed item ...
                                                 # if there are any ...
                                                   # and a close angle-bracket
my $in_angled;
$in_angled  = qr/ > ( [^<>] | (??{$in_angled}) )* < /x;
                  # open angle-bracket then ...
                      # non-angle chars ...
                            # or ...
                               # another angle-bracketed item ...
                                                 # if there are any ...
                                                   # and a close angle-bracket
my $in_or_out_bracketed = qr/ ($out_angled) | ($in_angled) /x;

################################
# Basic class methods.

# Create the object.
# - load and install plugins
# - make object available to test specs for callbacks
# - clear the tests and test count
# - process the command-line options
# - return the object
sub new {
  my ($class) = @_;
  my $self = {};
  bless $self, $class;

  $self->_deps(Graph->new);
  $self->sub_engine($sub_engine);

  # initialize fields first; plugins may expect good values.
  $self->next_line_callbacks([]);
  $self->tests([]);
  $self->test_count(0);
  $self->{InputQueue} = [];

  # Load and install the plugins.
  $self->_load_plugins();
  $self->install_pragma_plugins;

  # TestSpec needs to be able to find the App object.
  App::SimpleScan::TestSpec->app($self);

  # Read the command line and process the options.
  $self->handle_options;

  return $self;
}

# Read the test specs and turn them into tests.
# Add any additional code from the plugins.
# Return the tests as a string.
sub create_tests {
  my ($self) = @_;

  $self->transform_test_specs;
  $self->finalize_tests;
  return join q{}, @{$self->tests};
}

# If the tests should be run, run them.
# Return any exceptions to the caller.
sub execute {
  my ($self, $code) = @_;
  eval $code if ${$self->run};                         ##no critic
  return $EVAL_ERROR;
}

# Actually use the object.
# - create tests from input
# - run them if we should
# - print them if we should
sub go {
  my($self) = @_;
  my $exit_code = 0;

  my $code = $self->create_tests;
  # Note the dereference of the scalars here.

  if ($self->test_count) {
    if (my $result = $self->execute($code)) {
       warn $result,"\n";
       $exit_code = 1;
    }
  }
  else {
    if (${$self->warn}) {
      $self->stack_test(qq(fail "No tests were found in your input file.\n"));
      $exit_code = 1;
    }
  }

lib/App/SimpleScan.pm  view on Meta::CPAN

        $self->pragma(@{ $pragma_spec });
      }
    }
  }
  return;
}

########################
# Pragma methods and handlers

# Find the pragma code associated with the name.
sub pragma {
  my ($self, $name, $pragma) = @_;
  die "You forgot the pragma name\n" if ! defined $name;
  if (defined $pragma) {
    $self->{Pragma}->{$name} = $pragma;
  }
  return $self->{Pragma}->{$name};
}

# %%agent pragma handler. Verify that the argument
# is a valid WW::Mechanize agent alias string, and
# stack code to change it as appropriate.
sub _do_agent {
  my ($self, $rest) = @_;
  $rest = reverse $rest;
  my ($maybe_agent) = ($rest =~/^\s*(.*)$/mx);

  $maybe_agent = reverse $maybe_agent;
  if (grep { $_ eq $maybe_agent } $reference_mech->known_agent_aliases) {
    $self->_substitution_data('agent', $maybe_agent)
  }
  $self->stack_code(qq(user_agent("$maybe_agent");\n));
  return;
}

# %%cache - turn on Test::WWW::Simple's cache.
sub _do_cache {
  my ($self,$rest) = @_;
  $self->stack_code("cache();\n");
  return;
}

# %%nocache - turn off Test::WWW::Simple's cache.
sub _do_nocache {
  my ($self,$rest) = @_;
  $self->stack_code("no_cache();\n");
  return;
}

##########################
# Input queueing

# Handle input queueing. If there's anything queued,
# return it first; otherwise, just read another line
# from the magic input filehandle.
sub next_line {
  my ($self) = shift;
  my $next_line;

  # Call and plugin-installed input callbacks.
  # These can do whatever they like to the line stack, the
  # object, etc.
  foreach my $callback (@ {$self->next_line_callbacks() }) {
    $callback->($self);
  }

  # If we have lines on the input queue, read from there.
  if (defined $self->{InputQueue}->[0] ) {
    $next_line = shift @{ $self->{InputQueue} };
  }

  # Else we read lines from the standard input.
  else {
    $next_line = <>;
    if (defined $next_line) {
      $next_line =~ s/\n//mx;
      if ($run_status) {
        print STDERR "# |Processing '$next_line' (line $.)\n";
      }
    }
  }

  # record the text of the last line read for plugins to access
  # if they need it.
  $self->last_line($next_line);

  return $next_line;
}

# Preserve current line so that plugins can look at it
# if they want to.
sub last_line {
  my ($self, $line) = @_;
  if (defined $line) {
    $self->{CurrentLine} = $line;
  }
  return $self->{CurrentLine};
}

# Handle input stacking by pragmas. Add any new lines
# to the head of the queue.
sub queue_lines {
  my ($self, @lines) = @_;
  $self->{InputQueue} = [ @lines, @{ $self->{InputQueue} } ];
  return;
}

###########################
# Output queueing

# stack_code just adds code to the array holding
# the generated program.
sub stack_code {
  my ($self, @code) = @_;
  my @old_code = @{$self->tests};
  $self->tests([@old_code, @code]);
  return
}

# stack_test adds code to the array holding
# the generated program, and bumps the test
# count so we can use the proper number of tests
# in our test plan.

lib/App/SimpleScan.pm  view on Meta::CPAN

sub _depend {
  my($self, $item, @dependencies) = @_;

  if (!defined $item) {
    die "You don't want to do that anymore";
  }

  if (!@dependencies) {
    return ([ $self->_deps->successors($item) ]);
  }

  # Add these dependencies for the item.
  $self->_deps->add_edge($item, $_) for @dependencies;    ## no critic
  return;
}

1; # Magic true value required at end of module
__END__

=head1 NAME

App::SimpleScan - simple_scan's core code


=head1 VERSION

This document describes App::SimpleScan version 0.0.1


=head1 SYNOPSIS

    use App::SimpleScan;
    my $app = new App::SimpleScan;
    $app->go;



=head1 DESCRIPTION

C<App::SimpleScan> allows us to package the core of C<simple_scan>
as a class; most importantly, this allows us to use C<Module::Pluggable>
to write extensions to this application without directly modifying
this module or this C<simple_scan> application.

=head1 IMPORTANT NOTE

The interfaces to this module are still evolving; plugin
developers should monitor CPAN and look for new versions of
this module. Henceforth, any change to the externals of this
module will be denoted by a full version increase (e.g., from
0.34 to 1.00).

=head1 INTERFACE

=head2 Class methods

=head2 new

Creates a new instance of the application. Also invokes
all of the basic setup so that when C<go> is called, all
of the plugins are available and all callbacks are in place.

=head2 Instance methods

=head3 Execution methods

=head4 go

Executes the application. Calls the subsidiary methods to
read input, parse it, do substitutions, and transform it into
code; loads the plugins and any code filters which they wish to
install.

After the code is created, it consults the command-line
switches and runs the generated program, prints it, or both.

=head4 create_tests

Transforms the input into code, and finalizes them,
returning the actual test code (if any) to its caller.

=head2 transform_test_specs

Does all the work of transforming test specs into code,
including processing substitutions, test specs, and
pragmas, and handling substitutions.

=head2 finalize_tests

Adds all of the Perl modules required to run the tests to the
test code generated by this module. This includes any
modules specified by plugins via the plugin's C<test_modules>
class method.

=head2 execute

Actually run the generated test code. Currently just C<eval>'s
the generated code.

=head3 Options methods

=head4 parse_command_line

Parses the command line and sets the corresponding fields in the
C<App::SimpleScan> object. See the X<EXTENDING SIMPLESCAN> section
for more information.

=head4 handle_options

This method initializes your C<App::SimpleScan> object. It installs the
standard options (--run, --generate, and --warn), installs any
options defined by plugins, and then calls C<parse_command_line> to
actually parse the command line and set the options.

=head4 install_options(option => receiving_variable, "method_name")

Plugin method - optional.

Installs an entry into the options description passed
to C<GeOptions> when C<parse_command_line> is called. This
automatically creates an accessor for the option.

lib/App/SimpleScan.pm  view on Meta::CPAN

=head3 last_line

Plugin and core method.

Current input line setter/getter. Can be used by
plugins to look at the current line.

=head3 stack_code

Plugin and core method.

Adds code to the final output without incrementing the number of tests.
Does I<not> go through code filters, and does I<not> increment the
test count.

=head3 stack_test

Adds code to the final output and bumps the test count by one.
The code passes through any plugin code filters.

=head3 tests

Accessor that stores the test code generated during the run.

=head1 EXTENDING SIMPLESCAN

=head2 Adding new command-line options

Plugins can add new command-line options by defining an
C<options> class method which returns a list of
parameter/variable pairs, like those used to define
options with C<Getopt::Long>.

C<App::SimpleScan> will check for the C<options> method in
your plugin when it is loaded, and call it to install your
options automatically.

=head2 Adding new pragmas

Plugins can install new pragmas by implementing a C<pragmas>
class method. This method should return a list of array
references, with each array reference containing a
pragma name and a code reference which will implement the
pragma.

The actual pragma implementation will, when called by
C<transform_test_specs>, receive a reference to the
C<App::SimpleScan> object and the arguments to the pragma
(from the pragma line in the input) as a string of text. It is
up to the pragma to parse the string; the use of
C<expand_backticked> is recommended for pragmas which
take a variable number of arguments, and wish to adhere
to the same syntax that standard substitutions use.

=head1 PLUGIN SUMMARY

Standard plugin methods that App::SimpleScan will look for;
none of these is required, though you should choose to
implement the ones that you actually need.

=head2 Basic callbacks

=head3 init

The C<init> class method is called by C<App:SimpleScan>
when the plugin class is loaded; the C<App::SimpleScan>
object is suppled to allow the plugin to alter or add to the
contents of the object. This allows plugins to export methods
to the base class, or to add instance variables dynamically.

Note that the class passed in to this method is the class
of the I<plugin>, not of the caller (C<App::SimpleScan>
or a derived class). You should use C<caller()> if you wish
to export subroutines into the package corresponding to the
base class object.

=head3 pragmas

Defines any pragmas that this plugin implements. Returns a
list of names and subroutine references. These will be called
with a reference to the C<App::SimpleScan> object.

=head3 filters

Defines any code filters that this plugin wants to add to the
output filter queue. These methods are called with a copy
of the App::SimpleScan object and an array of code that is
about to be stacked. The filter should return an array
containing either the unaltered code, or the code with any
changes the plugin sees fit to make.

If your filter wants to stack tests, it should call
C<stack_code> and increment the test count itself (by
a call to test_count); trying to use C<stack_test> in
a filter will cause it to be called again and again in
an infinite recursive loop.

=head3 test_modules

If your plugin generates code that requires other Perl modules,
its test_modules class method should return an array of the names
of these modules.

=head3 options

Defines options to be added to the command-line options.
You should return an array of items that would be suitable
for passing to C<Getopt::Long>, which is what we'll do
with them.

=head3 validate_options

Validate your options. You can access any of the variables
you passed to C<options>; these will be initialized with
whatever values C<Getopt::Long> got from the command line.
You should try to ignore invalid values and choose defaults
for missing items if possible; if not, you should C<die>
with an appropriate message.

=head2 Methods to alter the input stream



( run in 2.276 seconds using v1.01-cache-2.11-cpan-cdf2f3d4e48 )