[Catalyst-commits] r7889 - in Catalyst-Plugin-SmartURI/1.000/trunk:
. lib/Catalyst lib/Catalyst/Plugin t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Wed Jun 4 06:34:45 BST 2008
Author: caelum
Date: 2008-06-04 06:34:45 +0100 (Wed, 04 Jun 2008)
New Revision: 7889
Added:
Catalyst-Plugin-SmartURI/1.000/trunk/t/03-uri-class.t
Removed:
Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/SmartURI.pm
Catalyst-Plugin-SmartURI/1.000/trunk/t/03-smart-uris.t
Catalyst-Plugin-SmartURI/1.000/trunk/t/uri/
Modified:
Catalyst-Plugin-SmartURI/1.000/trunk/Changes
Catalyst-Plugin-SmartURI/1.000/trunk/MANIFEST
Catalyst-Plugin-SmartURI/1.000/trunk/META.yml
Catalyst-Plugin-SmartURI/1.000/trunk/Makefile.PL
Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/Plugin/SmartURI.pm
Log:
Split off Smart URI into URI::SmartURI
Modified: Catalyst-Plugin-SmartURI/1.000/trunk/Changes
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/Changes 2008-06-03 22:06:49 UTC (rev 7888)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/Changes 2008-06-04 05:34:45 UTC (rev 7889)
@@ -5,3 +5,6 @@
0.01_01 2008-04-01 08:33:13
First dev release.
+
+0.02 2008-06-03 21:58:17
+ Moved Catalyst::SmartURI into a separate dist as URI::SmartURI
Modified: Catalyst-Plugin-SmartURI/1.000/trunk/MANIFEST
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/MANIFEST 2008-06-03 22:06:49 UTC (rev 7888)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/MANIFEST 2008-06-04 05:34:45 UTC (rev 7889)
@@ -11,7 +11,6 @@
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/Catalyst/Plugin/SmartURI.pm
-lib/Catalyst/SmartURI.pm
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
@@ -20,44 +19,6 @@
t/00-load.t
t/01-basic.t
t/02-c-a-rest-compat.t
-t/03-smart-uris.t
-t/04-smart-uri-subclass.t
+t/03-uri-class.t
t/boilerplate.t
t/pod.t
-t/uri/abs.t
-t/uri/clone.t
-t/uri/data.t
-t/uri/escape.t
-t/uri/file.t
-t/uri/ftp.t
-t/uri/generic.t
-t/uri/heuristic.t
-t/uri/http.t
-t/uri/ldap.t
-t/uri/mailto.t
-t/uri/mix.t
-t/uri/mms.t
-t/uri/news.t
-t/uri/old-absconf.t
-t/uri/old-base.t
-t/uri/old-file.t
-t/uri/old-relbase.t
-t/uri/pop.t
-t/uri/query-param.t
-t/uri/query.t
-t/uri/README
-t/uri/rel.t
-t/uri/rfc2732.t
-t/uri/roy-test.t
-t/uri/roytest1.html
-t/uri/roytest2.html
-t/uri/roytest3.html
-t/uri/roytest4.html
-t/uri/roytest5.html
-t/uri/rsync.t
-t/uri/rtsp.t
-t/uri/sip.t
-t/uri/split.t
-t/uri/storable-test.pl
-t/uri/storable.t
-t/uri/urn-oid.t
Modified: Catalyst-Plugin-SmartURI/1.000/trunk/META.yml
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/META.yml 2008-06-03 22:06:49 UTC (rev 7888)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/META.yml 2008-06-04 05:34:45 UTC (rev 7889)
@@ -20,8 +20,5 @@
Class::Accessor::Fast: 0
Class::C3::Componentised: 0
Class::Data::Inheritable: 0
- File::Find::Rule: 0
- List::MoreUtils: 0
- List::Util: 0
-tests: 't/*.t t/*/*.t'
-version: 0.01
+ URI::SmartURI: 0
+version: 0.02
Modified: Catalyst-Plugin-SmartURI/1.000/trunk/Makefile.PL
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/Makefile.PL 2008-06-03 22:06:49 UTC (rev 7888)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/Makefile.PL 2008-06-04 05:34:45 UTC (rev 7889)
@@ -6,16 +6,12 @@
requires 'Catalyst' => '5.7007';
requires 'Class::C3::Componentised';
-requires 'File::Find::Rule';
-requires 'List::Util';
-requires 'List::MoreUtils';
requires 'Class::Accessor::Fast';
requires 'Class::Data::Inheritable';
+requires 'URI::SmartURI';
build_requires 'Test::More';
-tests 't/*.t t/*/*.t';
-
auto_install;
WriteAll;
Modified: Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/Plugin/SmartURI.pm
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/Plugin/SmartURI.pm 2008-06-03 22:06:49 UTC (rev 7888)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/Plugin/SmartURI.pm 2008-06-04 05:34:45 UTC (rev 7889)
@@ -14,7 +14,7 @@
=cut
-our $VERSION = '0.01';
+our $VERSION = '0.02';
=head1 SYNOPSIS
@@ -39,14 +39,14 @@
what URI class $c->uri_for and $c->req->uri_with use, as well as whether the
URIs they produce are absolute, hostless or relative.
-To use your own URI class, just subclass L<Catalyst::SmartURI> and set
+To use your own URI class, just subclass L<URI::SmartURI> and set
uri_class, or write a class that follows the same interface.
This plugin installs a custom $c->request_class, however it does so in a way
that won't break if you've already set $c->request_class yourself (thanks mst!).
There will be a slight performance penalty for your first few requests, due to
-the way L<Catalyst::SmartURI> works, but after that you shouldn't notice
+the way L<URI::SmartURI> works, but after that you shouldn't notice
it. The penalty is considerably smaller in perl 5.10+.
=head1 CONFIGURATION
@@ -55,7 +55,7 @@
smarturi:
dispostion: absolute
- uri_class: 'Catalyst::SmartURI'
+ uri_class: 'URI::SmartURI'
=over
@@ -65,7 +65,7 @@
=item uri_class
-The class to use for URIs, defaults to L<Catalyst::SmartURI>.
+The class to use for URIs, defaults to L<URI::SmartURI>.
=back
@@ -130,7 +130,7 @@
my $app = shift;
my $config = $app->config->{smarturi};
- $config->{uri_class} ||= 'Catalyst::SmartURI';
+ $config->{uri_class} ||= 'URI::SmartURI';
$config->{disposition} ||= 'absolute';
my $request_class = $app->request_class;
@@ -175,7 +175,7 @@
=head1 SEE ALSO
-L<Catalyst::SmartURI>, L<Catalyst>, L<URI>
+L<URI::SmartURI>, L<Catalyst>, L<URI>
=head1 AUTHOR
@@ -184,7 +184,7 @@
=head1 BUGS
Please report any bugs or feature requests to
-C<bug-catalyst-plugin-relativepaths at rt.cpan.org>, or through the web
+C<bug-catalyst-plugin-smarturi at rt.cpan.org>, or through the web
interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Plugin-SmartURI>. I
will be notified, and then you'll automatically be notified of progress on your
@@ -233,6 +233,8 @@
I'd like to extend on L<Catalyst::Plugin::RequireSSL>, and make a plugin that
rewrites URIs for actions with an SSL attribute.
+Make a disposition that is based on the Host header.
+
=head1 COPYRIGHT & LICENSE
Copyright (c) 2008 Rafael Kitover
Deleted: Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/SmartURI.pm
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/SmartURI.pm 2008-06-03 22:06:49 UTC (rev 7888)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/SmartURI.pm 2008-06-04 05:34:45 UTC (rev 7889)
@@ -1,501 +0,0 @@
-package Catalyst::SmartURI;
-
-use strict;
-use warnings;
-
-=head1 NAME
-
-Catalyst::SmartURI - URIs with extra sugar
-
-=head1 VERSION
-
-Version 0.01
-
-=cut
-
-our $VERSION = '0.01';
-
-=head1 SYNOPSIS
-
- my $uri = Catalyst::SmartURI->new(
- 'http://host/foo/',
- { reference => 'http://host/bar/' }
- );
-
- my $hostless = $uri->hostless; # '/foo/'
-
- $hostless->absolute; # 'http://host/foo/'
-
- $uri->relative; # '../foo/'
-
-=cut
-
-use URI;
-use URI::URL;
-use Class::C3;
-use Class::C3::Componentised;
-use File::Find::Rule;
-use File::Spec::Functions qw/splitpath splitdir catfile/;
-use List::MoreUtils 'firstidx';
-use Scalar::Util 'blessed';
-use List::Util 'first';
-require Exporter;
-
-use base 'Class::Accessor::Fast';
-
-__PACKAGE__->mk_ro_accessors(qw/obj factory_class/);
-__PACKAGE__->mk_accessors(qw/reference/);
-
-=head1 DESCRIPTION
-
-This is a sort of "subclass" of L<URI> using delegation with some extra methods,
-all the methods that work for L<URI>s will work on these objects as well.
-
-It's similar in spirit to L<URI::WithBase>.
-
-It's also completely safe to subclass for your own use.
-
-=head1 CONSTRUCTORS
-
-=head2 Catalyst::SmartURI->new($str,
- [$scheme|{reference => $ref, scheme => $scheme}])
-
-Takes a uri $str and an optional scheme or hashref with a reference uri
-(for computing relative/absolute URIs) and an optional scheme.
-
- my $uri = Catalyst::SmartURI->new('http://dev.catalyst.perl.org/');
-
- my $uri = Catalyst::SmartURI->new('/catwiki.toeat.com/', 'http');
-
- my $uri = Catalyst::SmartURI->new(
- 'http://search.cpan.org/~jrockway/Catalyst-Manual-5.701003/',
- { reference => 'http://search.cpan.org/' }
- );
-
-The object returned will be blessed into a scheme-specific subclass, based on
-the class of the underlying $uri->obj (L<URI> object.) For example,
-Catalyst::SmartURI::http, which derives from L<Catalyst::SmartURI> (or
-$uri->factory_class if you're subclassing.)
-
-=cut
-
-sub new {
- my ($class, $uri, $opts) = @_;
-
- $opts = { scheme => $opts }
- unless ref($opts) && ref($opts) eq 'HASH';
-
- my $self = {
- obj => URI->new($class->_deflate_uris($uri, $opts->{scheme})),
- reference => $opts->{reference},
- factory_class => $class
- };
-
- bless $self, $class->_make_uri_class(blessed $self->{obj}, 1);
-}
-
-=head2 Catalyst::SmartURI->new_abs($str, $base_uri)
-
-Proxy for L<URI>->new_abs
-
-=cut
-
-sub new_abs {
- my $class = shift;
-
- my $self = {
- obj => URI->new_abs($class->_deflate_uris(@_)),
- factory_class => $class
- };
-
- bless $self, $class->_make_uri_class(blessed $self->{obj}, 1);
-}
-
-=head2 Catalyst::SmartURI->newlocal($filename, [$os])
-
-Proxy for L<URI::URL>->newlocal
-
-=cut
-
-sub newlocal {
- my $class = shift;
-
- my $self = {
- obj => URI::URL->newlocal($class->_deflate_uris(@_)),
- factory_class => $class
- };
-
- bless $self, $class->_make_uri_class(blessed $self->{obj}, 1);
-}
-
-=head1 METHODS
-
-=head2 $uri->hostless
-
-Returns the URI with the scheme and host parts stripped.
-
-=cut
-
-sub hostless {
- my $uri = $_[0]->clone;
-
- $uri->scheme('');
- $uri->host('');
- $uri->port('');
-
- $uri->factory_class->new(($uri =~ m!^[/:]*(/.*)!), $_[0]->_opts);
-}
-
-=head2 $uri->reference
-
-Accessor for the reference URI (for relative/absolute below.)
-
-=head2 $uri->relative
-
-Returns the URI relative to the reference URI.
-
-=cut
-
-sub relative { $_[0]->rel($_[0]->reference) }
-
-=head2 $uri->absolute
-
-Returns the absolute URI using the reference URI as base.
-
-=cut
-
-sub absolute { $_[0]->abs($_[0]->reference) }
-
-=head2 ""
-
-stringification works, just like with L<URI>s
-
-=head2 ==
-
-and == does as well
-
-=cut
-
-use overload
- '""' => sub { "".$_[0]->obj },
- '==' =>
- sub { overload::StrVal($_[0]->obj) eq overload::StrVal($_[1]->obj) },
- fallback => 1;
-
-=head2 $uri->eq($other_uri)
-
-Explicit equality check to another URI, can be used as
-Catalyst::SmartURI::eq($uri1, $uri2) as well.
-
-=cut
-
-sub eq {
- my ($self, $other) = @_;
-
-# Support URI::eq($first, $second) syntax. Not inheritance-safe :(
- $self = blessed $self ? $self : __PACKAGE__->new($self);
-
- return $self->obj->eq(ref $other eq blessed $self ? $other->obj : $other);
-}
-
-=head2 $uri->obj
-
-Accessor for the L<URI> object methods are delegated to.
-
-=head2 $uri->factory_class
-
-The class whose constructor was called to create the $uri object, usually
-L<Catalyst::SmartURI> or your own subclass. This is used to call class (rather
-than object) methods.
-
-=cut
-
-# The gory details
-
-sub AUTOLOAD {
- use vars qw/$CAN $AUTOLOAD/;
- no strict 'refs';
- my $self = $_[0];
-# stolen from URI sources
- my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
-
- return if ! blessed $self || $method eq 'DESTROY'
- || ! $self->obj->can($method);
-
- my $class = $self->factory_class;
-
- my $sub = blessed($self)."::$method";
-
- *{$sub} = sub {
- my $self = shift;
- my @res;
- if (wantarray) {
- @res = $self->obj->$method($class->_deflate_uris(@_));
- } else {
- $res[0] = $self->obj->$method($class->_deflate_uris(@_));
- }
- @res = $class->_inflate_uris(
- \@res,
- $method ne 'scheme' ? $self->_opts : {}
- );
-
- return wantarray ? @res : $res[0];
- };
-
- Class::C3::reinitialize;
-
- $CAN ? \&$sub : goto &$sub;
-}
-
-sub can { # of PORK BRAINS in MILK GRAVY, yum!!!
- no strict 'refs';
- use vars qw/$CAN $AUTOLOAD/;
- my ($self, $method) = @_;
-
- my $existing = eval { $self->next::method($method) };
- return $existing if $existing;
-
- local $AUTOLOAD = ref($self)."::$method";
- local $CAN = 1;
-
- $self->$method
-}
-
-# Preload some URI classes, the ones that come in files anyway,
-# but only if asked to.
-sub import {
- no strict 'refs';
- my $class = shift;
-
- return unless $_[0] && $_[0] eq '-import_uri_mods';
-
-# File::Find::Rule is not taint safe, and Module::Starter suggests running
-# tests in taint mode. Thanks for helping me with this one Somni!!!
- {
- no warnings 'redefine';
- my $getcwd = \&File::Find::Rule::getcwd;
- *File::Find::Rule::getcwd = sub { $getcwd->() =~ m!^(.*)\z! };
- # What are portably valid characters in a directory name anyway?
- }
-
- my @uri_pms = File::Find::Rule->extras({untaint => 1})->file->name('*.pm')
- ->in( File::Find::Rule->extras({untaint => 1})->directory
- ->maxdepth(1)->name('URI')->in(grep !ref($_), @INC)
- );
- my @new_uri_pms;
-
- for (@uri_pms) {
- my ($dir, $file) = (splitpath($_))[1,2];
-
- my @dir = grep $_ ne '', splitdir $dir;
- my @rel_dir = @dir[(firstidx { $_ eq 'URI' } @dir) .. $#dir];
- my $mod = join '::' => @rel_dir, ($file =~ /^(.*)\.pm\z/);
-
- my $new_class = $class->_make_uri_class($mod, 0);
-
- push @new_uri_pms, catfile(split /::/, $new_class) . '.pm';
- }
-
-# HLAGHALAGHLAGHLAGHLAGH
- push @INC, sub {
- if (first { $_ eq $_[1] } @new_uri_pms) {
- open my $fh, '<', \"1;\n";
- return $fh;
- }
- };
-
- Class::C3::reinitialize;
-}
-
-=head1 INTERNAL METHODS
-
-These are used internally by SmartURI, and are not interesting for general use,
-but may be useful for writing subclasses.
-
-=head2 $uri->_opts
-
-Returns a hashref of options for the $uri (reference and scheme.)
-
-=cut
-
-sub _opts { +{
- reference => $_[0]->reference || undef,
- scheme => $_[0]->scheme || undef
-} }
-
-
-=head2 $class->_resolve_uri_class($uri_class)
-
-Converts, eg., "URI::http" to "Catalyst::SmartURI::http".
-
-=cut
-
-sub _resolve_uri_class {
- my ($class, $uri_class) = @_;
-
- (my $new_class = $uri_class) =~ s/^URI::/${class}::/;
-
- return $new_class;
-}
-
-=head2 $class->_make_uri_class($uri_class)
-
-Creates a new proxy class class for a L<URI> class, with all exports and
-constructor intact, and returns its name, which is made using
-_resolve_uri_class (above).
-
-=cut
-
-sub _make_uri_class {
- my ($class, $uri_class, $re_init_c3) = @_;
-
- my $new_uri_class = $class->_resolve_uri_class($uri_class);
-
- no strict 'refs';
- no warnings 'redefine';
-
- unless (%{$new_uri_class.'::'}) {
- Class::C3::Componentised->inject_base(
- $new_uri_class, $class, 'Exporter'
- );
-
- *{$new_uri_class.'::new'} = sub {
- eval "require $uri_class";
- bless {
- obj => $uri_class->new($class->_deflate_uris(@_[1..$#_])),
- factory_class => $class
- }, $new_uri_class;
- };
-
- *{$new_uri_class.'::import'} = sub {
- shift; # $class
-
- eval "require $uri_class;";
- # URI doesn't use tags, thank god...
- my @vars = grep /^\W/, @_;
- my @subs = (@{$uri_class.'::EXPORT'}, grep /^\w/, @_);
-
- if (@vars) {
- my $import = $uri_class->can('import');
- @_ = ($uri_class, @vars);
- goto &$import;
- }
-
- for (@subs) {
- my $sub = $uri_class."::$_";
- my $proto = prototype $sub;
- $proto = $proto ? "($proto)" : '';
- eval qq{
- sub ${new_uri_class}::$_ $proto {
- my \@res;
- if (wantarray) {
- \@res = &${sub}($class->_deflate_uris(\@_));
- } else {
- \$res[0] = &${sub}($class->_deflate_uris(\@_));
- }
-
- \@res = $class->_inflate_uris(\\\@res);
-
- return wantarray ? \@res : \$res[0];
- }
- };
- }
-
- @{$new_uri_class."::EXPORT_OK"} = @subs;
-
- local $^W; # get rid of more redefined warnings
- $new_uri_class->export_to_level(1, $new_uri_class, @subs);
- };
-
- Class::C3::reinitialize if $re_init_c3;
- }
-
- return $new_uri_class;
-}
-
-=head2 $class->_inflate_uris(\@rray, $opts)
-
-Inflate any L<URI> objects in @rray into Catalyst::SmartURI objects, all other
-members pass through unharmed. $opts is a hashref of options to include in the
-objects created.
-
-=cut
-
-sub _inflate_uris {
- my $class = shift;
- my ($args, $opts) = @_;
-
- my @res = map { blessed($_) && blessed($_) =~ /^URI::/ ?
- bless {
- obj => $_,
- factory_class => $class,
- (defined $opts ? %$opts : ())
- },
- $class->_make_uri_class(blessed $_, 1)
- :
- $_
- } @$args;
- @res ? @res == 1 ? $res[0] : @res : ();
-}
-
-=head2 $class->_deflate_uris(@rray)
-
-Deflate any L<Catalyst::SmartURI> objects in @rray into the L<URI> objects
-they are proxies for, all other members pass through unharmed.
-
-=cut
-
-sub _deflate_uris {
- my $class = shift;
- my @res = map { blessed $_ && $_->isa($class) ? $_->{obj} : $_ } @_;
- @res ? @res == 1 ? $res[0] : @res : ();
-}
-
-=head1 MAGICAL IMPORT
-
-On import with the C<-import_uri_mods> flag it loads all the URI .pms into your
-class namespace.
-
-This works:
-
- use Catalyst::SmartURI '-import_uri_mods';
- use Catalyst::SmartURI::WithBase;
- use Catalyst::SmartURI::URL;
-
- my $url = Catalyst::SmartURI::URL->new(...); # URI::URL proxy
-
-Even this works:
-
- use Catalyst::SmartURI '-import_uri_mods';
- use Catalyst::SmartURI::Escape qw(%escapes);
-
-It even works with a subclass of L<Catalyst::SmartURI>.
-
-I only wrote this functionality so that I could run the URI test suite without
-much modification, it has no real practical value.
-
-=head1 SEE ALSO
-
-L<Catalyst::Plugin::SmartURI>, L<URI>, L<URI::WithBase>, L<Catalyst>
-
-=head1 ACKNOWLEDGEMENTS
-
-Thanks to folks on freenode #perl for helping me out when I was getting stuck,
-Somni, reverend, PerlJam and others whose nicks I forget.
-
-=head1 AUTHOR
-
-Rafael Kitover, C<< <rkitover at cpan.org> >>
-
-=head1 COPYRIGHT & LICENSE
-
-Copyright (c) 2008 Rafael Kitover
-
-This program is free software; you can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
-
-'LONG LIVE THE ALMIGHTY BUNGHOLE';
-
-# vim: expandtab shiftwidth=4 ts=4 tw=80:
Deleted: Catalyst-Plugin-SmartURI/1.000/trunk/t/03-smart-uris.t
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/t/03-smart-uris.t 2008-06-03 22:06:49 UTC (rev 7888)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/t/03-smart-uris.t 2008-06-04 05:34:45 UTC (rev 7889)
@@ -1,32 +0,0 @@
-#!perl -T
-
-use strict;
-use warnings;
-use Test::More tests => 8;
-
-use Catalyst::SmartURI;
-use URI;
-
-my $uri = Catalyst::SmartURI->new('http://www.catalystframework.org/calendar',
- { reference => 'http://www.catalystframework.org/' }
-);
-
-is($uri, 'http://www.catalystframework.org/calendar', 'stringification');
-
-is($uri->hostless, '/calendar', '$uri->hostless');
-
-ok($uri->hostless->eq('/calendar'), '$uri->eq 1');
-ok($uri->hostless->eq(Catalyst::SmartURI->new('/calendar', 'http')), '$uri->eq 2');
-ok($uri->hostless->eq(URI->new('/calendar', 'http')), '$uri->eq 3');
-
-is($uri->relative, 'calendar', '$uri->relative');
-
-is($uri->absolute, 'http://www.catalystframework.org/calendar', '$uri->absolute');
-
-is(
- $uri->relative->absolute->hostless->relative->absolute,
- 'http://www.catalystframework.org/calendar',
- 'sticky reference URI'
-);
-
-# vim: expandtab shiftwidth=4 ts=4 tw=80:
Added: Catalyst-Plugin-SmartURI/1.000/trunk/t/03-uri-class.t
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/t/03-uri-class.t (rev 0)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/t/03-uri-class.t 2008-06-04 05:34:45 UTC (rev 7889)
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+
+{
+ package MyURI;
+
+ use base 'URI::SmartURI';
+
+ sub mtfnpy {
+ my $uri = shift;
+ $uri->query_form([ $uri->query_form, qw(foo bar) ]);
+ $uri
+ }
+
+ package TestApp;
+
+ use Catalyst 'SmartURI';
+
+ sub foo : Global {
+ my ($self, $c) = @_;
+ $c->res->output($c->uri_for('/foo')->mtfnpy)
+ }
+
+ __PACKAGE__->config->{smarturi}{uri_class} = 'MyURI';
+ __PACKAGE__->setup;
+}
+
+use Catalyst::Test 'TestApp';
+
+is(get('/foo'), 'http://localhost/foo?foo=bar', 'configured uri_class');
+
+# vim: expandtab shiftwidth=4 ts=4 tw=80:
More information about the Catalyst-commits
mailing list