[catagits/Catalyst-Runtime.git] / lib / Catalyst / Utils.pm

package Catalyst::Utils;

use strict;
use File::Spec;
use HTTP::Request;
use Path::Class;
use URI;
use Carp qw/croak/;
use Cwd;
use Class::MOP;
use String::RewritePrefix;

use namespace::clean;

=head1 NAME

Catalyst::Utils - The Catalyst Utils

=head1 SYNOPSIS

See L<Catalyst>.

=head1 DESCRIPTION

Catalyst Utilities.

=head1 METHODS

=head2 appprefix($class)

    MyApp::Foo becomes myapp_foo

=cut

sub appprefix {
    my $class = shift;
    $class =~ s/::/_/g;
    $class = lc($class);
    return $class;
}

=head2 class2appclass($class);

    MyApp::Controller::Foo::Bar becomes MyApp
    My::App::Controller::Foo::Bar becomes My::App

=cut

sub class2appclass {
    my $class = shift || '';
    my $appname = '';
    if ( $class =~ /^(.+?)::([MVC]|Model|View|Controller)::.+$/ ) {
        $appname = $1;
    }
    return $appname;
}

=head2 class2classprefix($class);

    MyApp::Controller::Foo::Bar becomes MyApp::Controller
    My::App::Controller::Foo::Bar becomes My::App::Controller

=cut

sub class2classprefix {
    my $class = shift || '';
    my $prefix;
    if ( $class =~ /^(.+?::([MVC]|Model|View|Controller))::.+$/ ) {
        $prefix = $1;
    }
    return $prefix;
}

=head2 class2classsuffix($class);

    MyApp::Controller::Foo::Bar becomes Controller::Foo::Bar

=cut

sub class2classsuffix {
    my $class = shift || '';
    my $prefix = class2appclass($class) || '';
    $class =~ s/$prefix\:://;
    return $class;
}

=head2 class2classshortsuffix($class)

    MyApp::Controller::Foo::Bar becomes Foo::Bar

=cut

sub class2classshortsuffix {
    my $class  = shift || '';
    my $prefix = class2classprefix($class) || '';
    $class =~ s/$prefix\:://;
    return $class;
}


=head2 class2env($class);

Returns the environment name for class.

    MyApp becomes MYAPP
    My::App becomes MY_APP

=cut

sub class2env {
    my $class = shift || '';
    $class =~ s/::/_/g;
    return uc($class);
}

=head2 class2prefix( $class, $case );

Returns the uri prefix for a class. If case is false the prefix is converted to lowercase.

    My::App::Controller::Foo::Bar becomes foo/bar

=cut

sub class2prefix {
    my $class = shift || '';
    my $case  = shift || 0;
    my $prefix;
    if ( $class =~ /^.+?::([MVC]|Model|View|Controller)::(.+)$/ ) {
        $prefix = $case ? $2 : lc $2;
        $prefix =~ s{::}{/}g;
    }
    return $prefix;
}

=head2 class2tempdir( $class [, $create ] );

Returns a tempdir for a class. If create is true it will try to create the path.

    My::App becomes /tmp/my/app
    My::App::Controller::Foo::Bar becomes /tmp/my/app/c/foo/bar

=cut

sub class2tempdir {
    my $class  = shift || '';
    my $create = shift || 0;
    my @parts = split '::', lc $class;

    my $tmpdir = dir( File::Spec->tmpdir, @parts )->cleanup;

    if ( $create && !-e $tmpdir ) {

        eval { $tmpdir->mkpath };

        if ($@) {
            # don't load Catalyst::Exception as a BEGIN in Utils,
            # because Utils often gets loaded before MyApp.pm, and if
            # Catalyst::Exception is loaded before MyApp.pm, it does
            # not honor setting
            # $Catalyst::Exception::CATALYST_EXCEPTION_CLASS in
            # MyApp.pm
            require Catalyst::Exception;
            Catalyst::Exception->throw(
                message => qq/Couldn't create tmpdir '$tmpdir', "$@"/ );
        }
    }

    return $tmpdir->stringify;
}

=head2 home($class)

Returns home directory for given class.

=head2 dist_indicator_file_list

Returns a list of files which can be tested to check if you're inside
a CPAN distribution which is not yet installed.

These are:

=over

=item Makefile.PL

=item Build.PL

=item dist.ini

=back

=cut

sub dist_indicator_file_list {
    qw{Makefile.PL Build.PL dist.ini};
}

sub home {
    my $class = shift;

    # make an $INC{ $key } style string from the class name
    (my $file = "$class.pm") =~ s{::}{/}g;

    if ( my $inc_entry = $INC{$file} ) {
        {
            # look for an uninstalled Catalyst app

            # find the @INC entry in which $file was found
            (my $path = $inc_entry) =~ s/$file$//;
            $path ||= cwd() if !defined $path || !length $path;
            my $home = dir($path)->absolute->cleanup;

            # pop off /lib and /blib if they're there
            $home = $home->parent while $home =~ /b?lib$/;

            # only return the dir if it has a Makefile.PL or Build.PL or dist.ini
            if (grep { -f $home->file($_) } dist_indicator_file_list()) {
                # clean up relative path:
                # MyApp/script/.. -> MyApp

                my $dir;
                my @dir_list = $home->dir_list();
                while (($dir = pop(@dir_list)) && $dir eq '..') {
                    $home = dir($home)->parent->parent;
                }

                return $home->stringify;
            }
        }

        {
            # look for an installed Catalyst app

            # trim the .pm off the thing ( Foo/Bar.pm -> Foo/Bar/ )
            ( my $path = $inc_entry) =~ s/\.pm$//;
            my $home = dir($path)->absolute->cleanup;

            # return if if it's a valid directory
            return $home->stringify if -d $home;
        }
    }

    # we found nothing
    return 0;
}

=head2 prefix($class, $name);

Returns a prefixed action.

    MyApp::Controller::Foo::Bar, yada becomes foo/bar/yada

=cut

sub prefix {
    my ( $class, $name ) = @_;
    my $prefix = &class2prefix($class);
    $name = "$prefix/$name" if $prefix;
    return $name;
}

=head2 request($uri)

Returns an L<HTTP::Request> object for a uri.

=cut

sub request {
    my $request = shift;
    unless ( ref $request ) {
        if ( $request =~ m/^http/i ) {
            $request = URI->new($request);
        }
        else {
            $request = URI->new( 'http://localhost' . $request );
        }
    }
    unless ( ref $request eq 'HTTP::Request' ) {
        $request = HTTP::Request->new( 'GET', $request );
    }
    return $request;
}

=head2 ensure_class_loaded($class_name, \%opts)

Loads the class unless it already has been loaded.

If $opts{ignore_loaded} is true always tries the require whether the package
already exists or not. Only pass this if you're either (a) sure you know the
file exists on disk or (b) have code to catch the file not found exception
that will result if it doesn't.

=cut

sub ensure_class_loaded {
    my $class = shift;
    my $opts  = shift;

    croak "Malformed class Name $class"
        if $class =~ m/(?:\b\:\b|\:{3,})/;

    croak "Malformed class Name $class"
        if $class =~ m/[^\w:]/;

    croak "ensure_class_loaded should be given a classname, not a filename ($class)"
        if $class =~ m/\.pm$/;

    # $opts->{ignore_loaded} can be set to true, and this causes the class to be required, even
    # if it already has symbol table entries. This is to support things like Schema::Loader, which
    # part-generate classes in memory, but then also load some of their contents from disk.
    return if !$opts->{ ignore_loaded }
        && Class::MOP::is_class_loaded($class); # if a symbol entry exists we don't load again

    # this hack is so we don't overwrite $@ if the load did not generate an error
    my $error;
    {
        local $@;
        my $file = $class . '.pm';
        $file =~ s{::}{/}g;
        eval { CORE::require($file) };
        $error = $@;
    }

    die $error if $error;

    warn "require $class was successful but the package is not defined."
        unless Class::MOP::is_class_loaded($class);

    return 1;
}

=head2 merge_hashes($hashref, $hashref)

Base code to recursively merge two hashes together with right-hand precedence.

=cut

sub merge_hashes {
    my ( $lefthash, $righthash ) = @_;

    return $lefthash unless defined $righthash;

    my %merged = %$lefthash;
    for my $key ( keys %$righthash ) {
        my $right_ref = ( ref $righthash->{ $key } || '' ) eq 'HASH';
        my $left_ref  = ( ( exists $lefthash->{ $key } && ref $lefthash->{ $key } ) || '' ) eq 'HASH';
        if( $right_ref and $left_ref ) {
            $merged{ $key } = merge_hashes(
                $lefthash->{ $key }, $righthash->{ $key }
            );
        }
        else {
            $merged{ $key } = $righthash->{ $key };
        }
    }

    return \%merged;
}

=head2 env_value($class, $key)

Checks for and returns an environment value. For instance, if $key is
'home', then this method will check for and return the first value it finds,
looking at $ENV{MYAPP_HOME} and $ENV{CATALYST_HOME}.

=cut

sub env_value {
    my ( $class, $key ) = @_;

    $key = uc($key);
    my @prefixes = ( class2env($class), 'CATALYST' );

    for my $prefix (@prefixes) {
        if ( defined( my $value = $ENV{"${prefix}_${key}"} ) ) {
            return $value;
        }
    }

    return;
}

=head2 term_width

Try to guess terminal width to use with formatting of debug output

All you need to get this work, is:

1) Install Term::Size::Any, or

2) Export $COLUMNS from your shell.

(Warning to bash users: 'echo $COLUMNS' may be showing you the bash
variable, not $ENV{COLUMNS}. 'export COLUMNS=$COLUMNS' and you should see
that 'env' now lists COLUMNS.)

As last resort, default value of 80 chars will be used.

=cut

my $_term_width;

sub term_width {
    return $_term_width if $_term_width;

    my $width = eval '
        use Term::Size::Any;
        my ($columns, $rows) = Term::Size::Any::chars;
        return $columns;
    ';

    if ($@) {
        $width = $ENV{COLUMNS}
            if exists($ENV{COLUMNS})
            && $ENV{COLUMNS} =~ m/^\d+$/;
    }

    $width = 80 unless ($width && $width >= 80);
    return $_term_width = $width;
}


=head2 resolve_namespace

Method which adds the namespace for plugins and actions.

  __PACKAGE__->setup(qw(MyPlugin));

  # will load Catalyst::Plugin::MyPlugin

=cut


sub resolve_namespace {
    my $appnamespace = shift;
    my $namespace = shift;
    my @classes = @_;
    return String::RewritePrefix->rewrite({
        q[]  => qq[${namespace}::],
        q[+] => q[],
        (defined $appnamespace
            ? (q[~] => qq[${appnamespace}::])
            : ()
        ),
    }, @classes);
}


=head1 AUTHORS

Catalyst Contributors, see Catalyst.pm

=head1 COPYRIGHT

This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

1;
Commit	Line	Data
f05af9ba	1	package Catalyst::Utils;
	2
	3	use strict;
37a3ac5c	4	use File::Spec;
d837e1a7	5	use HTTP::Request;
812a28c9	6	use Path::Class;
d837e1a7	7	use URI;
5e5bd6df	8	use Carp qw/croak/;
a8946dc8	9	use Cwd;
808db1d6	10	use Class::MOP;
17b3d800	11	use String::RewritePrefix;
17b3d800	12
0db6e9d5	13	use namespace::clean;
0db6e9d5	14
f05af9ba	15	=head1 NAME
	16
	17	Catalyst::Utils - The Catalyst Utils
	18
	19	=head1 SYNOPSIS
	20
	21	See L<Catalyst>.
	22
	23	=head1 DESCRIPTION
	24
b0ad47c1	25	Catalyst Utilities.
39fc2ce1	26
f05af9ba	27	=head1 METHODS
f05af9ba	28
b5ecfcf0	29	=head2 appprefix($class)
41ca9ba7	30
85d9fce6	31	MyApp::Foo becomes myapp_foo
41ca9ba7	32
	33	=cut
	34
	35	sub appprefix {
	36	my $class = shift;
0ef447d8	37	$class =~ s/::/_/g;
41ca9ba7	38	$class = lc($class);
	39	return $class;
	40	}
	41
b5ecfcf0	42	=head2 class2appclass($class);
84cf74e7	43
0ef447d8	44	MyApp::Controller::Foo::Bar becomes MyApp
0ef447d8	45	My::App::Controller::Foo::Bar becomes My::App
2d90477f	46
84cf74e7	47	=cut
	48
	49	sub class2appclass {
	50	my $class = shift \|\| '';
	51	my $appname = '';
0ef447d8	52	if ( $class =~ /^(.+?)::([MVC]\|Model\|View\|Controller)::.+$/ ) {
84cf74e7	53	$appname = $1;
	54	}
	55	return $appname;
	56	}
	57
b5ecfcf0	58	=head2 class2classprefix($class);
2930d610	59
0ef447d8	60	MyApp::Controller::Foo::Bar becomes MyApp::Controller
0ef447d8	61	My::App::Controller::Foo::Bar becomes My::App::Controller
2d90477f	62
2930d610	63	=cut
	64
	65	sub class2classprefix {
	66	my $class = shift \|\| '';
	67	my $prefix;
0ef447d8	68	if ( $class =~ /^(.+?::([MVC]\|Model\|View\|Controller))::.+$/ ) {
2930d610	69	$prefix = $1;
	70	}
	71	return $prefix;
	72	}
	73
b5ecfcf0	74	=head2 class2classsuffix($class);
84cf74e7	75
0ef447d8	76	MyApp::Controller::Foo::Bar becomes Controller::Foo::Bar
2d90477f	77
84cf74e7	78	=cut
	79
	80	sub class2classsuffix {
	81	my $class = shift \|\| '';
	82	my $prefix = class2appclass($class) \|\| '';
0ef447d8	83	$class =~ s/$prefix\:://;
84cf74e7	84	return $class;
	85	}
	86
1532731f	87	=head2 class2classshortsuffix($class)
	88
	89	MyApp::Controller::Foo::Bar becomes Foo::Bar
	90
	91	=cut
	92
	93	sub class2classshortsuffix {
	94	my $class = shift \|\| '';
	95	my $prefix = class2classprefix($class) \|\| '';
	96	$class =~ s/$prefix\:://;
	97	return $class;
	98	}
	99
	100
b5ecfcf0	101	=head2 class2env($class);
3ad654e0	102
26e73131	103	Returns the environment name for class.
3ad654e0	104
	105	MyApp becomes MYAPP
	106	My::App becomes MY_APP
	107
	108	=cut
	109
	110	sub class2env {
	111	my $class = shift \|\| '';
0ef447d8	112	$class =~ s/::/_/g;
3ad654e0	113	return uc($class);
	114	}
	115
b5ecfcf0	116	=head2 class2prefix( $class, $case );
f05af9ba	117
e2cc89a9	118	Returns the uri prefix for a class. If case is false the prefix is converted to lowercase.
f05af9ba	119
0ef447d8	120	My::App::Controller::Foo::Bar becomes foo/bar
2d90477f	121
f05af9ba	122	=cut
	123
	124	sub class2prefix {
	125	my $class = shift \|\| '';
e494bd6b	126	my $case = shift \|\| 0;
f05af9ba	127	my $prefix;
0ef447d8	128	if ( $class =~ /^.+?::([MVC]\|Model\|View\|Controller)::(.+)$/ ) {
e494bd6b	129	$prefix = $case ? $2 : lc $2;
0ef447d8	130	$prefix =~ s{::}{/}g;
f05af9ba	131	}
	132	return $prefix;
	133	}
	134
b5ecfcf0	135	=head2 class2tempdir( $class [, $create ] );
37a3ac5c	136
e2cc89a9	137	Returns a tempdir for a class. If create is true it will try to create the path.
37a3ac5c	138
37a3ac5c	139	My::App becomes /tmp/my/app
7d7519a4	140	My::App::Controller::Foo::Bar becomes /tmp/my/app/c/foo/bar
37a3ac5c	141
	142	=cut
	143
	144	sub class2tempdir {
	145	my $class = shift \|\| '';
	146	my $create = shift \|\| 0;
4be535b1	147	my @parts = split '::', lc $class;
37a3ac5c	148
	149	my $tmpdir = dir( File::Spec->tmpdir, @parts )->cleanup;
	150
4be535b1	151	if ( $create && !-e $tmpdir ) {
37a3ac5c	152
	153	eval { $tmpdir->mkpath };
	154
4be535b1	155	if ($@) {
41a8bf1f	156	# don't load Catalyst::Exception as a BEGIN in Utils,
	157	# because Utils often gets loaded before MyApp.pm, and if
	158	# Catalyst::Exception is loaded before MyApp.pm, it does
	159	# not honor setting
	160	# $Catalyst::Exception::CATALYST_EXCEPTION_CLASS in
	161	# MyApp.pm
	162	require Catalyst::Exception;
37a3ac5c	163	Catalyst::Exception->throw(
4be535b1	164	message => qq/Couldn't create tmpdir '$tmpdir', "$@"/ );
37a3ac5c	165	}
	166	}
	167
	168	return $tmpdir->stringify;
	169	}
	170
a8946dc8	171	=head2 home($class)
	172
	173	Returns home directory for given class.
	174
0f519d62	175	=head2 dist_indicator_file_list
0f519d62	176
a8946dc8	177	Returns a list of files which can be tested to check if you're inside
e01b6093	178	a CPAN distribution which is not yet installed.
	179
	180	These are:
	181
	182	=over
	183
	184	=item Makefile.PL
	185
	186	=item Build.PL
	187
	188	=item dist.ini
	189
	190	=back
0f519d62	191
	192	=cut
	193
	194	sub dist_indicator_file_list {
a8946dc8	195	qw{Makefile.PL Build.PL dist.ini};
0f519d62	196	}
0f519d62	197
812a28c9	198	sub home {
51f412bd	199	my $class = shift;
	200
	201	# make an $INC{ $key } style string from the class name
	202	(my $file = "$class.pm") =~ s{::}{/}g;
	203
	204	if ( my $inc_entry = $INC{$file} ) {
51452916	205	{
51f412bd	206	# look for an uninstalled Catalyst app
	207
	208	# find the @INC entry in which $file was found
	209	(my $path = $inc_entry) =~ s/$file$//;
a8946dc8	210	$path \|\|= cwd() if !defined $path \|\| !length $path;
	211	my $home = dir($path)->absolute->cleanup;
	212
	213	# pop off /lib and /blib if they're there
	214	$home = $home->parent while $home =~ /b?lib$/;
	215
	216	# only return the dir if it has a Makefile.PL or Build.PL or dist.ini
	217	if (grep { -f $home->file($_) } dist_indicator_file_list()) {
	218	# clean up relative path:
	219	# MyApp/script/.. -> MyApp
	220
	221	my $dir;
	222	my @dir_list = $home->dir_list();
	223	while (($dir = pop(@dir_list)) && $dir eq '..') {
	224	$home = dir($home)->parent->parent;
	225	}
	226
	227	return $home->stringify;
	228	}
51452916	229	}
4be535b1	230
51f412bd	231	{
	232	# look for an installed Catalyst app
	233
	234	# trim the .pm off the thing ( Foo/Bar.pm -> Foo/Bar/ )
	235	( my $path = $inc_entry) =~ s/\.pm$//;
	236	my $home = dir($path)->absolute->cleanup;
	237
	238	# return if if it's a valid directory
	239	return $home->stringify if -d $home;
62459712	240	}
812a28c9	241	}
51f412bd	242
	243	# we found nothing
	244	return 0;
812a28c9	245	}
812a28c9	246
b5ecfcf0	247	=head2 prefix($class, $name);
812a28c9	248
	249	Returns a prefixed action.
	250
0ef447d8	251	MyApp::Controller::Foo::Bar, yada becomes foo/bar/yada
812a28c9	252
	253	=cut
	254
	255	sub prefix {
	256	my ( $class, $name ) = @_;
	257	my $prefix = &class2prefix($class);
	258	$name = "$prefix/$name" if $prefix;
	259	return $name;
	260	}
	261
b5ecfcf0	262	=head2 request($uri)
4d60aa90	263
e2cc89a9	264	Returns an L<HTTP::Request> object for a uri.
4d60aa90	265
	266	=cut
	267
	268	sub request {
	269	my $request = shift;
	270	unless ( ref $request ) {
a88c7ec8	271	if ( $request =~ m/^http/i ) {
f4c0f6f7	272	$request = URI->new($request);
4d60aa90	273	}
4d60aa90	274	else {
f4c0f6f7	275	$request = URI->new( 'http://localhost' . $request );
4d60aa90	276	}
	277	}
	278	unless ( ref $request eq 'HTTP::Request' ) {
	279	$request = HTTP::Request->new( 'GET', $request );
	280	}
4d60aa90	281	return $request;
	282	}
	283
dd91afb5	284	=head2 ensure_class_loaded($class_name, \%opts)
d9183506	285
	286	Loads the class unless it already has been loaded.
	287
dd91afb5	288	If $opts{ignore_loaded} is true always tries the require whether the package
	289	already exists or not. Only pass this if you're either (a) sure you know the
	290	file exists on disk or (b) have code to catch the file not found exception
	291	that will result if it doesn't.
	292
d9183506	293	=cut
	294
	295	sub ensure_class_loaded {
	296	my $class = shift;
d06051f7	297	my $opts = shift;
d9183506	298
5e5bd6df	299	croak "Malformed class Name $class"
	300	if $class =~ m/(?:\b\:\b\|\:{3,})/;
	301
59ede84e	302	croak "Malformed class Name $class"
	303	if $class =~ m/[^\w:]/;
	304
	305	croak "ensure_class_loaded should be given a classname, not a filename ($class)"
	306	if $class =~ m/\.pm$/;
	307
f55d1491	308	# $opts->{ignore_loaded} can be set to true, and this causes the class to be required, even
	309	# if it already has symbol table entries. This is to support things like Schema::Loader, which
	310	# part-generate classes in memory, but then also load some of their contents from disk.
d06051f7	311	return if !$opts->{ ignore_loaded }
fbedfd6b	312	&& Class::MOP::is_class_loaded($class); # if a symbol entry exists we don't load again
fbedfd6b	313
d9183506	314	# this hack is so we don't overwrite $@ if the load did not generate an error
	315	my $error;
	316	{
	317	local $@;
7a1958eb	318	my $file = $class . '.pm';
	319	$file =~ s{::}{/}g;
	320	eval { CORE::require($file) };
d9183506	321	$error = $@;
d9183506	322	}
6bfff75e	323
d9183506	324	die $error if $error;
fbedfd6b	325
f55d1491	326	warn "require $class was successful but the package is not defined."
fbedfd6b	327	unless Class::MOP::is_class_loaded($class);
6bfff75e	328
6bfff75e	329	return 1;
d9183506	330	}
d9183506	331
358e1592	332	=head2 merge_hashes($hashref, $hashref)
	333
	334	Base code to recursively merge two hashes together with right-hand precedence.
	335
	336	=cut
	337
	338	sub merge_hashes {
	339	my ( $lefthash, $righthash ) = @_;
	340
	341	return $lefthash unless defined $righthash;
b0ad47c1	342
358e1592	343	my %merged = %$lefthash;
0ef447d8	344	for my $key ( keys %$righthash ) {
	345	my $right_ref = ( ref $righthash->{ $key } \|\| '' ) eq 'HASH';
	346	my $left_ref = ( ( exists $lefthash->{ $key } && ref $lefthash->{ $key } ) \|\| '' ) eq 'HASH';
	347	if( $right_ref and $left_ref ) {
358e1592	348	$merged{ $key } = merge_hashes(
358e1592	349	$lefthash->{ $key }, $righthash->{ $key }
0ef447d8	350	);
358e1592	351	}
	352	else {
	353	$merged{ $key } = $righthash->{ $key };
0ef447d8	354	}
358e1592	355	}
b0ad47c1	356
358e1592	357	return \%merged;
	358	}
	359
cb69249e	360	=head2 env_value($class, $key)
	361
	362	Checks for and returns an environment value. For instance, if $key is
	363	'home', then this method will check for and return the first value it finds,
	364	looking at $ENV{MYAPP_HOME} and $ENV{CATALYST_HOME}.
	365
	366	=cut
	367
	368	sub env_value {
	369	my ( $class, $key ) = @_;
	370
	371	$key = uc($key);
	372	my @prefixes = ( class2env($class), 'CATALYST' );
	373
	374	for my $prefix (@prefixes) {
	375	if ( defined( my $value = $ENV{"${prefix}_${key}"} ) ) {
	376	return $value;
	377	}
	378	}
	379
	380	return;
	381	}
d9183506	382
39fc2ce1	383	=head2 term_width
	384
	385	Try to guess terminal width to use with formatting of debug output
	386
	387	All you need to get this work, is:
	388
	389	1) Install Term::Size::Any, or
	390
b0ad47c1	391	2) Export $COLUMNS from your shell.
39fc2ce1	392
39fc2ce1	393	(Warning to bash users: 'echo $COLUMNS' may be showing you the bash
b0ad47c1	394	variable, not $ENV{COLUMNS}. 'export COLUMNS=$COLUMNS' and you should see
39fc2ce1	395	that 'env' now lists COLUMNS.)
	396
	397	As last resort, default value of 80 chars will be used.
	398
	399	=cut
	400
	401	my $_term_width;
	402
	403	sub term_width {
	404	return $_term_width if $_term_width;
	405
	406	my $width = eval '
	407	use Term::Size::Any;
	408	my ($columns, $rows) = Term::Size::Any::chars;
	409	return $columns;
	410	';
	411
	412	if ($@) {
	413	$width = $ENV{COLUMNS}
	414	if exists($ENV{COLUMNS})
	415	&& $ENV{COLUMNS} =~ m/^\d+$/;
	416	}
	417
	418	$width = 80 unless ($width && $width >= 80);
	419	return $_term_width = $width;
	420	}
	421
17b3d800	422
	423	=head2 resolve_namespace
	424
	425	Method which adds the namespace for plugins and actions.
	426
	427	__PACKAGE__->setup(qw(MyPlugin));
196932de	428
17b3d800	429	# will load Catalyst::Plugin::MyPlugin
	430
	431	=cut
	432
	433
	434	sub resolve_namespace {
5d8129e9	435	my $appnamespace = shift;
17b3d800	436	my $namespace = shift;
17b3d800	437	my @classes = @_;
196932de	438	return String::RewritePrefix->rewrite({
	439	q[] => qq[${namespace}::],
	440	q[+] => q[],
	441	(defined $appnamespace
	442	? (q[~] => qq[${appnamespace}::])
	443	: ()
	444	),
	445	}, @classes);
17b3d800	446	}
	447
	448
2f381252	449	=head1 AUTHORS
f05af9ba	450
2f381252	451	Catalyst Contributors, see Catalyst.pm
f05af9ba	452
	453	=head1 COPYRIGHT
	454
536bee89	455	This library is free software. You can redistribute it and/or modify it under
f05af9ba	456	the same terms as Perl itself.
	457
	458	=cut
	459
	460	1;