lib/Maypole/CLI.pm

   1 package Maypole::CLI;
   2 use UNIVERSAL::require;
   3 use URI; use URI::QueryParam;
   4 use Maypole::Constants;
   5
   6 use strict;
   7 use warnings;
   8 my $package;
   9 our $buffer;
  10 sub import {
  11     $package = $_[1];
  12     $package->require;
  13     die "Couldn't require $package - $@" if $@;
  14     no strict 'refs';
  15     unshift @{$package."::ISA"}, "Maypole::CLI";
  16 }
  17
  18 sub get_request {}
  19 sub get_template_root { $ENV{MAYPOLE_TEMPLATES} || "." }
  20
  21 sub parse_location {
  22     my $self = shift;
  23     my $url = URI->new(shift @ARGV);
  24     my $root = URI->new($self->config->{uri_base})->path;
  25     $self->{path} = $url->path;
  26     $self->{path} =~ s/^$root//i if $root;
  27     $self->parse_path;
  28     $self->parse_args($url);
  29 }
  30
  31 sub parse_args {
  32     my ($self,$url) = @_;
  33     $self->{params} = $url->query_form_hash;
  34     $self->{query} = $url->query_form_hash;
  35 }
  36
  37 sub send_output { $buffer = shift->{output} }
  38
  39 sub call_url {
  40         my $self =shift;
  41         @ARGV=@_;
  42     $package->handler() == OK and return $buffer;
  43 }
  44 # Do it!
  45 CHECK { if ((caller(0))[1] eq "-e") {
  46             $package->handler() == OK and print $buffer;
  47        } }
  48
  49 1;
  50
  51 =head1 NAME
  52
  53 Maypole::CLI - Command line interface to Maypole for testing and debugging
  54
  55 =head1 SYNOPSIS
  56
  57   % setenv MAYPOLE_TEMPLATES /var/www/beerdb/
  58   % perl -MMaypole::CLI=BeerDB -e1 http://localhost/beerdb/brewery/frontpage
  59
  60 =head1 DESCRIPTION
  61
  62 This module is used to test Maypole sites without going through a web
  63 server or modifying them to use a CGI frontend. To use it, you should
  64 first either be in the template root for your Maypole site or set the
  65 environment variable C<MAYPOLE_TEMPLATES> to the right value.
  66
  67 Next, you import the C<Maypole::CLI> module specifying your base Maypole
  68 subclass. The usual way to do this is with the C<-M> flag:
  69 C<perl -MMaypole::CLI=MyApp>. This is equivalent to:
  70
  71     use Maypole::CLI qw(MyApp);
  72
  73 Now Maypole will automatically call your application's handler with the
  74 URL specified as the first command line parameter. This should be the
  75 full URL, starting from whatever you have defined as the C<uri_base> in
  76 your application's configuration, and may include query parameters.
  77
  78 The Maypole HTML output should then end up on standard output.
  79
  80 =head1 Support for testing
  81
  82 The module can also be used as part of a test script.
  83
  84 When used programmatically, rather than from the command line, its
  85 behaviour is slightly different.
  86
  87 Although the URL is taken from C<@ARGV> as normal, your application's
  88 C<handler> method is not called automatically, as it is when used on the
  89 command line; you need to call it manually. Additionally, when
  90 C<handler> is called, the output is not printed to standard output but
  91 stored in C<$Maypole::CLI::buffer>, to allow you to check the contents
  92 more easily.
  93
  94 For instance, a test script could look like this:
  95
  96     use Test::More tests => 5;
  97     use Maypole::CLI qw(BeerDB);
  98     use Maypole::Constants;
  99     $ENV{MAYPOLE_TEMPLATES} = "t/templates";
 100
 101     # Hack because isa_ok only supports object isa not class isa
 102     isa_ok( (bless {},"BeerDB") , "Maypole");
 103
 104     @ARGV = ("http://localhost/beerdb/");
 105     is(BeerDB->handler, OK, "OK");
 106     like($Maypole::CLI::buffer, qr/frontpage/, "Got the front page");
 107
 108     @ARGV = ("http://localhost/beerdb/beer/list");
 109     is(BeerDB->handler, OK, "OK");
 110     like($Maypole::CLI::buffer, qr/Organic Best/, "Found a beer in the list");
 111