lib/Catalyst/Utils.pm

   1 package Catalyst::Utils;
   2
   3 use strict;
   4 use attributes ();
   5
   6 =head1 NAME
   7
   8 Catalyst::Utils - The Catalyst Utils
   9
  10 =head1 SYNOPSIS
  11
  12 See L<Catalyst>.
  13
  14 =head1 DESCRIPTION
  15
  16 =head1 METHODS
  17
  18 =over 4
  19
  20 =item attrs($coderef)
  21
  22 Returns attributes for coderef in a arrayref
  23
  24 =cut
  25
  26 sub attrs { attributes::get( $_[0] ) || [] }
  27
  28 =item prefix($class, $name);
  29
  30 Returns a prefixed action.
  31
  32     MyApp::C::Foo::Bar, yada becomes /foo/bar/yada
  33
  34 =cut
  35
  36 sub prefix {
  37     my ( $class, $name ) = @_;
  38     my $prefix = &class2prefix($class);
  39     $name = "$prefix/$name" if $prefix;
  40     return $name;
  41 }
  42
  43 =item class2appclass($class);
  44
  45 Returns the appclass for class.
  46
  47     MyApp::C::Foo::Bar becomes MyApp
  48     My::App::C::Foo::Bar becomes My::App
  49
  50 =cut
  51
  52 sub class2appclass {
  53     my $class = shift || '';
  54     my $appname = '';
  55     if ( $class =~ /^(.*)::([MVC]|Model|View|Controller)?::.*$/ ) {
  56         $appname = $1;
  57     }
  58     return $appname;
  59 }
  60
  61 =item class2classprefix($class);
  62
  63 Returns the classprefix for class.
  64
  65     MyApp::C::Foo::Bar becomes MyApp::C
  66     My::App::C::Foo::Bar becomes My::App::C
  67
  68 =cut
  69
  70 sub class2classprefix {
  71     my $class = shift || '';
  72     my $prefix;
  73     if ( $class =~ /^(.*::[MVC]|Model|View|Controller)?::.*$/ ) {
  74         $prefix = $1;
  75     }
  76     return $prefix;
  77 }
  78
  79 =item class2classsuffix($class);
  80
  81 Returns the classsuffix for class.
  82
  83     MyApp::C::Foo::Bar becomes C::Foo::Bar
  84
  85 =cut
  86
  87 sub class2classsuffix {
  88     my $class = shift || '';
  89     my $prefix = class2appclass($class) || '';
  90     $class =~ s/$prefix\:\://;
  91     return $class;
  92 }
  93
  94 =item class2prefix($class);
  95
  96 Returns the prefix for class.
  97
  98     My::App::C::Foo::Bar becomes /foo/bar
  99
 100 =cut
 101
 102 sub class2prefix {
 103     my $class = shift || '';
 104     my $prefix;
 105     if ( $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/ ) {
 106         $prefix = lc $2;
 107         $prefix =~ s/\:\:/\//g;
 108     }
 109     return $prefix;
 110 }
 111
 112 =back
 113
 114 =head1 AUTHOR
 115
 116 Sebastian Riedel, C<sri@cpan.org>
 117
 118 =head1 COPYRIGHT
 119
 120 This program is free software, you can redistribute it and/or modify it under
 121 the same terms as Perl itself.
 122
 123 =cut
 124
 125 1;