5.01 XXX Apr XX XX:00:00 2005
- some documentation bugs fixed
+ - added Catalyst::Utils
5.00 Fri Apr 15 18:00:00 2005
- new core to support inheritance trees
use strict;
use base 'Class::Data::Inheritable';
-use Memoize;
+use Catalyst::Utils;
use Text::ASCIITable;
use Tree::Simple;
use Tree::Simple::Visitor::FindByPath;
# We use a tree
__PACKAGE__->tree( Tree::Simple->new( 0, Tree::Simple->ROOT ) );
-memoize('_class2prefix');
-
=head1 NAME
Catalyst::Dispatcher - The Catalyst Dispatcher
unless ($namespace) {
if ( my $result = $c->get_action($action) ) {
- $namespace = _class2prefix( $result->[0]->[0]->[0] );
+ $namespace =
+ Catalyst::Utils::class2prefix( $result->[0]->[0]->[0] );
}
}
$command =~ s/^\///;
}
- else { $namespace = _class2prefix($caller) || '/' }
+ else { $namespace = Catalyst::Utils::class2prefix($caller) || '/' }
my $results = $c->get_action( $command, $namespace );
sub set_action {
my ( $c, $method, $code, $namespace, $attrs ) = @_;
- my $prefix = _class2prefix($namespace) || '';
+ my $prefix = Catalyst::Utils::class2prefix($namespace) || '';
my %flags;
for my $attr ( @{$attrs} ) {
if ( @{ $regexes->{tbl_rows} } && $self->debug );
}
-sub _prefix {
- my ( $class, $name ) = @_;
- my $prefix = _class2prefix($class);
- $name = "$prefix/$name" if $prefix;
- return $name;
-}
-
-sub _class2prefix {
- my $class = shift || '';
- my $prefix;
- if ( $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/ ) {
- $prefix = lc $2;
- $prefix =~ s/\:\:/\//g;
- }
- return $prefix;
-}
-
=back
=head1 AUTHOR
--- /dev/null
+package Catalyst::Utils;
+
+use strict;
+use attributes ();
+
+=head1 NAME
+
+Catalyst::Utils - The Catalyst Utils
+
+=head1 SYNOPSIS
+
+See L<Catalyst>.
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=over 4
+
+=item attrs($coderef)
+
+Returns attributes for coderef in a arrayref
+
+=cut
+
+sub attrs { attributes::get( $_[0] ) || [] }
+
+=item prefix($class, $name);
+
+Returns a prefixed action.
+
+=cut
+
+sub prefix {
+ my ( $class, $name ) = @_;
+ my $prefix = &class2prefix($class);
+ $name = "$prefix/$name" if $prefix;
+ return $name;
+}
+
+=item class2prefix($class);
+
+Returns the prefix for class.
+
+=cut
+
+sub class2prefix {
+ my $class = shift || '';
+ my $prefix;
+ if ( $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/ ) {
+ $prefix = lc $2;
+ $prefix =~ s/\:\:/\//g;
+ }
+ return $prefix;
+}
+
+=back
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@cpan.org>
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;