[Catalyst-commits] r7475 - Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst

[caelum at dev.catalyst.perl.org]

Author: caelum
Date: 2008-03-10 23:12:26 +0000 (Mon, 10 Mar 2008)
New Revision: 7475

Modified:
   Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/SmartURI.pm
Log:
Nicer subclassing method, but doesn't quite work yet...


Modified: Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/SmartURI.pm
===================================================================
--- Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/SmartURI.pm	2008-03-10 20:26:05 UTC (rev 7474)
+++ Catalyst-Plugin-SmartURI/1.000/trunk/lib/Catalyst/SmartURI.pm	2008-03-10 23:12:26 UTC (rev 7475)
@@ -19,7 +19,7 @@
 
     my $uri = Catalyst::SmartURI->new('http://catalyst.perl.org/calendar');
 
-    my $hostless = $uri->hostless; # stringifies to '/catalyst.perl.org/calendar'
+    my $hostless= $uri->hostless; # stringifies to '/catalyst.perl.org/calendar'
 
 =cut
 
@@ -30,32 +30,47 @@
 sub new {
     my $class = shift;
 
+    # URI objects are not really URI objects, but URI::http etc.
     my $self = $class->next::method(@_);
 
-    # URI objects are not really URI objects, but URI::http etc.
-    Class::C3::Componentised->inject_base($class, ref $self);   
-    Class::C3::reinitialize();
+    my $uri_class      = ref $self;
+    (my $new_uri_class = $uri_class) =~ s/^URI::/Catalyst::SmartURI::/;
 
-    bless $self, $class;
+    no strict 'refs';
+
+    unless (%{$new_uri_class.'::'}) {
+        Class::C3::Componentised->inject_base(
+            $new_uri_class,
+            'Catalyst::SmartURI::__BASE__',
+            $uri_class
+        );   
+        Class::C3::reinitialize();
+    }
+
+    bless $self, $new_uri_class;
 }
 
-sub hostless {
-    my $uri = shift;
+{
+    package Catalyst::SmartURI::__BASE__;
 
-    $uri->scheme('');
-    $uri->host('');
+    sub hostless {
+        my $uri = shift;
 
-    my $class = ref $uri;
+        $uri->scheme('');
+        $uri->host('');
 
-    return $class->new( $uri =~ m!^/*(/.*)! );
-};
+        my $class = ref $uri;
 
+        return $class->new( $uri =~ m!^/*(/.*)! );
+    }
+}
+
 =head1 AUTHOR
 
 Rafael Kitover, C<< <rkitover at cpan.org> >>
 
 =cut
 
-1; # End of Catalyst::SmartURI
+'LONG LIVE THE ALMIGHTY BUNGHOLE'; # End of Catalyst::SmartURI
 
 # vim: expandtab shiftwidth=4 ts=4 tw=80: