File Coverage

blib/lib/App/Dochazka/REST/Mason.pm
Criterion Covered Total %
statement 21 32 65.6
branch 0 4 0.0
condition 0 12 0.0
subroutine 7 10 70.0
pod 1 1 100.0
total 29 59 49.1


line stmt bran cond sub pod time code
1             # *************************************************************************
2             # Copyright (c) 2014-2015, SUSE LLC
3             #
4             # All rights reserved.
5             #
6             # Redistribution and use in source and binary forms, with or without
7             # modification, are permitted provided that the following conditions are met:
8             #
9             # 1. Redistributions of source code must retain the above copyright notice,
10             # this list of conditions and the following disclaimer.
11             #
12             # 2. Redistributions in binary form must reproduce the above copyright
13             # notice, this list of conditions and the following disclaimer in the
14             # documentation and/or other materials provided with the distribution.
15             #
16             # 3. Neither the name of SUSE LLC nor the names of its contributors may be
17             # used to endorse or promote products derived from this software without
18             # specific prior written permission.
19             #
20             # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
21             # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22             # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23             # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
24             # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
25             # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
26             # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
27             # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
28             # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
29             # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
30             # POSSIBILITY OF SUCH DAMAGE.
31             # *************************************************************************
32              
33             # ------------------------
34             # store and dispense Mason interpreter singleton
35             # ------------------------
36              
37              
38             use strict;
39 42     42   1046 use warnings;
  42         77  
  42         1038  
40 42     42   185  
  42         77  
  42         1027  
41             use App::CELL qw( $CELL $log $site );
42 42     42   197 use Mason;
  42         74  
  42         3232  
43 42     42   16140 use Params::Validate qw( :all );
  42         39127202  
  42         1362  
44 42     42   340 use Try::Tiny;
  42         89  
  42         7255  
45 42     42   271  
  42         96  
  42         2072  
46              
47              
48             =head1 NAME
49              
50             App::Dochazka::REST::Mason - Mason interpreter singleton
51              
52              
53              
54             =head1 SYNOPSIS
55              
56             use App::Dochazka::REST::Mason qw( $interp );
57              
58              
59              
60             =head1 DESCRIPTION
61              
62             Mason interpreter singleton.
63              
64             =cut
65              
66              
67              
68             =head1 EXPORTS
69              
70             =cut
71              
72             use Exporter qw( import );
73 42     42   236 our @EXPORT_OK = qw( $comp_root $interp );
  42         89  
  42         12072  
74              
75              
76              
77             =head1 PACKAGE VARIABLES
78              
79             This module stores and initializes the L<Mason> interpreter singleton object.
80              
81             =cut
82              
83             our ( $comp_root, $interp );
84              
85              
86              
87             =head1 FUNCTIONS
88              
89              
90             =head2 init_singleton
91              
92             Initialize the C<$interp> singleton. Takes a C<comp_root> and a
93             C<data_dir> which are expected to exist and be owned by the effective user.
94              
95             Idempotent.
96              
97             FIXME: Add parameters to the Mason->new() call as needed.
98              
99             =cut
100              
101             my @ARGS = @_;
102             my %ARGS;
103 0     0 1   my $status = $CELL->status_ok;
104 0           try {
105 0           %ARGS = validate(
106             @ARGS, {
107 0     0     comp_root => { type => SCALAR },
108             data_dir => { type => SCALAR },
109             }
110             );
111             die "Mason comp_root $ARGS{comp_root} has a problem" unless
112             (
113             -r $ARGS{comp_root} and
114             -w $ARGS{comp_root} and
115             -x $ARGS{comp_root}
116             );
117             die "Mason comp_root $ARGS{data_dir} has a problem" unless
118 0 0 0       (
      0        
119             -r $ARGS{comp_root} and
120             -w $ARGS{comp_root} and
121             -x $ARGS{comp_root}
122             );
123             $interp = Mason->new(
124 0 0 0       comp_root => $ARGS{comp_root},
      0        
125             data_dir => $ARGS{data_dir},
126             class_header => q(
127             use App::CELL qw( $CELL $log $meta $site );
128 0           ),
129             );
130             $comp_root = $ARGS{comp_root};
131             } catch {
132 0           $status = $CELL->status_crit( 'DOCHAZKA_MASON_INIT_FAIL', args => [ $_ ] );
133             };
134 0     0     return $status;
135 0           }
136 0            
137             1;