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 =cut
  33
  34 sub prefix {
  35     my ( $class, $name ) = @_;
  36     my $prefix = &class2prefix($class);
  37     $name = "$prefix/$name" if $prefix;
  38     return $name;
  39 }
  40
  41 =item class2appclass($class);
  42
  43 Returns the appclass for class.
  44
  45 =cut
  46
  47 sub class2appclass {
  48     my $class = shift || '';
  49     my $appname = '';
  50     if ( $class =~ /^(.*)::([MVC]|Model|View|Controller)?::.*$/ ) {
  51         $appname = $1;
  52     }
  53     return $appname;
  54 }
  55
  56 =item class2classprefix($class);
  57
  58 Returns the classprefix for class.
  59
  60 =cut
  61
  62 sub class2classprefix {
  63     my $class = shift || '';
  64     my $prefix;
  65     if ( $class =~ /^(.*::[MVC]|Model|View|Controller)?::.*$/ ) {
  66         $prefix = $1;
  67     }
  68     return $prefix;
  69 }
  70
  71 =item class2classsuffix($class);
  72
  73 Returns the classsuffix for class.
  74
  75 =cut
  76
  77 sub class2classsuffix {
  78     my $class = shift || '';
  79     my $prefix = class2appclass($class) || '';
  80     $class =~ s/$prefix\:\://;
  81     return $class;
  82 }
  83
  84 =item class2prefix($class);
  85
  86 Returns the prefix for class.
  87
  88 =cut
  89
  90 sub class2prefix {
  91     my $class = shift || '';
  92     my $prefix;
  93     if ( $class =~ /^.*::([MVC]|Model|View|Controller)?::(.*)$/ ) {
  94         $prefix = lc $2;
  95         $prefix =~ s/\:\:/\//g;
  96     }
  97     return $prefix;
  98 }
  99
 100 =back
 101
 102 =head1 AUTHOR
 103
 104 Sebastian Riedel, C<sri@cpan.org>
 105
 106 =head1 COPYRIGHT
 107
 108 This program is free software, you can redistribute it and/or modify it under
 109 the same terms as Perl itself.
 110
 111 =cut
 112
 113 1;