File: CLI.pm

package info (click to toggle)
maypole 2.10-1
  • links: PTS
  • area: main
  • in suites: etch-m68k
  • size: 472 kB
  • ctags: 108
  • sloc: perl: 1,345; makefile: 21
file content (142 lines) | stat: -rw-r--r-- 3,660 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
package Maypole::CLI;
use UNIVERSAL::require;
use URI;
use URI::QueryParam;
use Maypole::Constants;

use strict;
use warnings;
my $package;
our $buffer;

# Command line action
CHECK {
    if ( ( caller(0) )[1] eq "-e" ) {
        $package->handler() == OK and print $buffer;
    }
}

sub import {
    $package = $_[1];
    $package->require;
    die "Couldn't require $package - $@" if $@;
    no strict 'refs';
    unshift @{ $package . "::ISA" }, "Maypole::CLI";
}

sub get_template_root { $ENV{MAYPOLE_TEMPLATES} || "." }

sub parse_location {
    my $self = shift;
    my $url  = URI->new( shift @ARGV );
    (my $uri_base = $self->config->uri_base) =~ s:/$::;
    my $root = URI->new( $uri_base )->path;
    $self->{path} = $url->path;
    $self->{path} =~ s:^$root/?::i if $root;
    $self->parse_path;
    $self->parse_args($url);
}

sub parse_args {
    my ( $self, $url ) = @_;
    $self->{params} = $url->query_form_hash;
    $self->{query}  = $url->query_form_hash;
}

sub send_output { $buffer = shift->{output} }

sub call_url {
    my $self = shift;
    local @ARGV = @_;
    $package->handler() == OK and return $buffer;
}


1;

=head1 NAME

Maypole::CLI - Command line interface to Maypole for testing and debugging

=head1 SYNOPSIS

  % setenv MAYPOLE_TEMPLATES /var/www/beerdb/
  % perl -MMaypole::CLI=BeerDB -e1 http://localhost/beerdb/brewery/frontpage

=head1 DESCRIPTION

This module is used to test Maypole sites without going through a web
server or modifying them to use a CGI frontend. To use it, you should
first either be in the template root for your Maypole site or set the
environment variable C<MAYPOLE_TEMPLATES> to the right value.

Next, you import the C<Maypole::CLI> module specifying your base Maypole
subclass. The usual way to do this is with the C<-M> flag: 
C<perl -MMaypole::CLI=MyApp>. This is equivalent to:

    use Maypole::CLI qw(MyApp);

Now Maypole will automatically call your application's handler with the
URL specified as the first command line parameter. This should be the
full URL, starting from whatever you have defined as the C<uri_base> in
your application's configuration, and may include query parameters.

The Maypole HTML output should then end up on standard output.

=head1 Support for testing

The module can also be used as part of a test script. 

When used programmatically, rather than from the command line, its
behaviour is slightly different. 

Although the URL is taken from C<@ARGV> as normal, your application's
C<handler> method is not called automatically, as it is when used on the
command line; you need to call it manually. Additionally, when
C<handler> is called, the output is not printed to standard output but
stored in C<$Maypole::CLI::buffer>, to allow you to check the contents
more easily.

For instance, a test script could look like this:

    use Test::More tests => 3;
    use Maypole::CLI qw(BeerDB);
    use Maypole::Constants;
    $ENV{MAYPOLE_TEMPLATES} = "t/templates";

    # Hack because isa_ok only supports object isa not class isa
    isa_ok( (bless {},"BeerDB") , "Maypole");

    like(BeerDB->call_url("http://localhost/beerdb/"), qr/frontpage/, "Got the front page");

    like(BeerDB->call_url("http://localhost/beerdb/beer/list"), qr/Organic Best/, "Found a beer in the list");

=head1 METHODS 

=over 

=item call_url

for use in scripts. takes an url as argument, and returns the buffer. 

=back


=head1 Implementation

This class overrides a set of methods in the base Maypole class to provide it's 
functionality. See L<Maypole> for these:

=over

=item get_template_root

=item parse_args

=item parse_location

=item send_output

=back

=cut