X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FCLI.pm;h=8f8a50eb4cd0243a71ff514a644a04e652c0a9a6;hb=32ecafee815b0fd8043c0acc2c785f5748fc20ff;hp=b08aab17fe838b17171b2e725ea6b5b8f2000435;hpb=c65a614ae26a095e67ec7c07edb001e80ee91232;p=maypole.git

diff --git a/lib/Maypole/CLI.pm b/lib/Maypole/CLI.pm
index b08aab1..8f8a50e 100644
--- a/lib/Maypole/CLI.pm
+++ b/lib/Maypole/CLI.pm
@@ -1,50 +1,63 @@
 package Maypole::CLI;
 use UNIVERSAL::require;
-use URI; use URI::QueryParam;
+use URI;
+use URI::QueryParam;
 use Maypole::Constants;
 
 use strict;
 use warnings;
 my $package;
 our $buffer;
-sub import { 
+
+# 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";
+    unshift @{ $package . "::ISA" }, "Maypole::CLI";
 }
 
-sub get_request {}
 sub get_template_root { $ENV{MAYPOLE_TEMPLATES} || "." }
 
+sub warn {
+    my ($self,@args) = @_;
+    my ($package, $line) = (caller)[0,2];
+    warn "[$package line $line] ", @args ;
+    return;
+}
+
 sub parse_location {
     my $self = shift;
-    my $url = URI->new(shift @ARGV);
-    my $root = URI->new($self->config->{uri_base})->path;
+    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->{path} =~ s:^$root/?::i if $root;
     $self->parse_path;
     $self->parse_args($url);
 }
 
 sub parse_args {
-    my ($self,$url) = @_;
+    my ( $self, $url ) = @_;
     $self->{params} = $url->query_form_hash;
-    $self->{query} = $url->query_form_hash;
+    $self->{query}  = $url->query_form_hash;
 }
 
 sub send_output { $buffer = shift->{output} }
 
 sub call_url {
-	my $self =shift;
-	@ARGV=@_;
-    $package->handler() == OK and return $buffer; 
+    my $self = shift;
+    local @ARGV = @_;
+    $package->handler() == OK and return $buffer;
 }
-# Do it!
-CHECK { if ((caller(0))[1] eq "-e") { 
-            $package->handler() == OK and print $buffer; 
-       } }
+
 
 1;
 
@@ -93,7 +106,7 @@ more easily.
 
 For instance, a test script could look like this:
 
-    use Test::More tests => 5;
+    use Test::More tests => 3;
     use Maypole::CLI qw(BeerDB);
     use Maypole::Constants;
     $ENV{MAYPOLE_TEMPLATES} = "t/templates";
@@ -101,11 +114,36 @@ For instance, a test script could look like this:
     # Hack because isa_ok only supports object isa not class isa
     isa_ok( (bless {},"BeerDB") , "Maypole");
 
-    @ARGV = ("http://localhost/beerdb/");
-    is(BeerDB->handler, OK, "OK");
-    like($Maypole::CLI::buffer, qr/frontpage/, "Got the front page");
+    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
 
-    @ARGV = ("http://localhost/beerdb/beer/list");
-    is(BeerDB->handler, OK, "OK");
-    like($Maypole::CLI::buffer, qr/Organic Best/, "Found a beer in the list");
+=back
 
+=cut