From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

JKUTEJ / Catalyst-Plugin-CommandLine-0.05 / lib / Catalyst / Plugin / CommandLine.pm 

            

              
1
—
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
—
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
—
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
—
112
113
114
115
116
117
118
119
120
121
122
123
124
125

              
package Catalyst::Plugin::CommandLine;
=head1 NAME
Catalyst::Plugin::CommandLine - Catalyst plugin to make $c available also for scripts.
=head1 SYNOPSIS
        # in MyCatalystApp.pm
        use Catalyst qw( CommandLine );
        # in a script
        use MyCatalystApp;
        my $c = MyCatalystApp->commandline;
         
        $c->stash->{ ...
        $c->model( ...
        $c->controller( ...
        $c->view( ...
=head1 DESCRIPTION
Use this module if you need to have access to the Catalyst controllers or models from
command line script.
=cut
use base qw/Class::Data::Inheritable/;
use strict;
use warnings;
use NEXT;
use UNIVERSAL qw{ can };
use HTTP::Headers;
use Catalyst::Request;
use Catalyst::Response;
use URI::http;
our $VERSION = "0.05";
=head1 FUNCTIONS
=head2 commandline
Will setup $c so that it could be used in the script.
Setups stash, request, response, sessionid.
=cut
sub commandline {
    my $class;
    my $c;
        # if called as constructor then contruct the object
    if (ref $_[0] eq '') {
        $class = shift;
        $c = $class->new();
    }
    # otherwise get "$self"
    else {
            $c = shift;
             
            # prevent reinitializing
            return $c if $c->commandline_mode;
    }
     
        my $uri_path = '/';
        my $uri = \$uri_path;
        bless $uri, 'URI::http';
        my $base = \$c->config->{'base'};
        bless $base, 'URI::http';
        $c->stash({ CommandLine => 1 });
        $c->request(Catalyst::Request->new({
                'cookies' => {},
                'base'    => $base,
                'uri'     => $uri,
                'secure'  => 1,
                'headers' => HTTP::Headers->new,
        }));
        $c->response(Catalyst::Response->new({
                'cookies' => {},
                'headers' => HTTP::Headers->new,
        }));
        # execute the root auto method
        $c->controller('Root')->auto($c)
            if $c->controller('Root')->can('auto');
         
        return $c;
}
=head2 commandline_mode
Returns true/false if catalyst is running in commandline mode.
=cut
sub commandline_mode {
        my $c = shift;
         
        return 1 if ($c->stash and $c->stash->{'CommandLine'});
        return 0;
}
1;
=head1 AUTHOR
Jozef Kutej - E<lt>jkutej@cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2007 by Jozef Kutej
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
=cut