File Coverage

blib/lib/Web/MREST/InitRouter.pm
Criterion Covered Total %
statement 66 71 92.9
branch 21 26 80.7
condition 3 4 75.0
subroutine 13 14 92.8
pod 0 1 0.0
total 103 116 88.7


line stmt bran cond sub pod time code
1             # *************************************************************************
2             # Copyright (c) 2014-2015-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             package Web::MREST::InitRouter;
34              
35 22     22   481 use 5.012;
  22         87  
36 22     22   130 use strict;
  22         83  
  22         506  
37 22     22   127 use warnings;
  22         51  
  22         1012  
38              
39 22     22   163 use App::CELL qw( $log $meta $site );
  22         58  
  22         2058  
40 22     22   150 use Data::Dumper;
  22         42  
  22         899  
41 22     22   7705 use Path::Router;
  22         3854326  
  22         879  
42 22     22   206 use Try::Tiny;
  22         54  
  22         3201  
43              
44              
45             =head1 NAME
46              
47             Web::MREST::InitRouter - Routines for initializing our Path::Router instance
48              
49              
50              
51             =head1 SYNOPSIS
52              
53             L<Web::MREST> uses L<Path::Router> to match URIs to resources. All resources
54             are packed into a single object. The singleton is exported as C<$router> from
55             this module and can be initialized by calling C<init_router>, which is also
56             exported, with no arguments.
57              
58             use Web::MREST::InitRouter qw( $router );
59              
60             ...
61              
62             Web::MREST::InitRouter::init_router() unless defined $router and $router->can( 'match' );
63              
64              
65              
66              
67             =head1 PACKAGE VARIABLES
68              
69             =cut
70              
71             our $router;
72             our $resources = {};
73             our @non_expandable_properties = qw( parent validations documentation resource_name children );
74             our %no_expand_map = map { ( $_ => '' ) } @non_expandable_properties;
75              
76              
77             =head1 EXPORTS
78              
79             This module provides the following exports:
80              
81             =over
82              
83             =item C<$router> (Path::Router singleton)
84              
85             =item C<$resources> (expanded resource definitions)
86              
87             =back
88              
89             =cut
90              
91 22     22   163 use Exporter qw( import );
  22         52  
  22         15966  
92             our @EXPORT_OK = qw( $router $resources );
93              
94              
95             =head1 FUNCTIONS
96              
97             =cut
98              
99              
100             #
101             # read in multiple resource definitions from a hash
102             #
103             sub load_resource_defs {
104 20     20 0 76 my $defs = shift;
105             #$log->debug("Entering " . __PACKAGE__. "::_load_resource_defs with argument " . Dumper( $defs ));
106              
107             # first pass -> expand resource defs and add them to $resources
108 20         219 foreach my $resource ( keys( %$defs ) ) {
109             # each resource definition is a hash.
110 240 50       234283 if ( ref( $defs->{$resource} ) eq 'HASH' ) {
111 240         611 _process_resource_def( $resource, $defs->{$resource} );
112             } else {
113 0         0 die "AAAAAAAHHHHHHH! Definition of resource $resource is not a hashref!";
114             }
115 240         439 _add_route( $resource );
116             }
117             }
118              
119              
120             # processes an individual resource definition hash and adds Path::Router route
121             # for it
122             sub _process_resource_def {
123 240     240   529 my ( $resource, $resource_def ) = @_;
124             #$log->debug("Entering " . __PACKAGE__. "::_process_resource_def with:" );
125 240         1827 $log->info("Initializing \$resource ->$resource<-");
126             #$log->debug("\$resource_def " . Dumper( $resource_def ) );
127              
128             # expand all properties except those in %no_expand_map
129 240         38943 foreach my $prop ( keys %$resource_def ) {
130 1160 100       2378 next if exists $no_expand_map{ $prop };
131 700         1288 _expand_property( $resource, $resource_def, $prop );
132             }
133              
134             # handle non-expandable properties
135             #
136             # - validations
137 240         464 my $validations = $resource_def->{'validations'};
138 240 100       550 $resources->{$resource}->{'validations'} = $validations if $resource_def->{'validations'};
139             #
140             # - documentation
141 240         397 my $documentation = $resource_def->{'documentation'};
142 240 100       573 $resources->{$resource}->{'documentation'} = $documentation if $resource_def->{'documentation'};
143             #
144             # - parent
145 240 100       521 if ( $resource ne '/' ) {
146 220   50     502 my $parent = $resource_def->{'parent'} || '/';
147 220         312 push( @{ $resources->{$parent}->{'children'} }, $resource );
  220         621  
148 220         458 $resources->{$resource}->{'parent'} = $parent;
149             }
150              
151 240         421 return;
152             }
153              
154              
155             sub _add_route {
156 240     240   363 my $resource = shift;
157 240         338 my %validations;
158 240 100       541 if ( ref( $resources->{$resource}->{'validations'} ) eq 'HASH' ) {
159 20         52 %validations = %{ $resources->{$resource}->{'validations'} };
  20         107  
160 20         60 delete $resources->{$resource}->{'validations'};
161             }
162             my $ARGS = {
163 240         826 target => $resources->{$resource},
164             };
165 240 100       483 $ARGS->{'validations'} = \%validations if %validations;
166            
167             try {
168 240     240   10717 $router->add_route( $resource, %$ARGS );
169             } catch {
170 0     0   0 $log->crit( $_ );
171 240         1710 };
172             }
173              
174              
175             # takes an individual resource definition property, expands it and puts it in
176             # $resources package variable
177             sub _expand_property {
178 700     700   1150 my ( $resource, $resource_def, $prop ) = @_;
179             #$log->debug("Entering " . __PACKAGE__. "::_expand_property with " .
180             # "resource \"$resource\" and property \"$prop\"" );
181              
182             # set the resource_name property
183 700         1279 $resources->{$resource}->{'resource_name'} = $resource;
184              
185             my @supported_methods = ( ref( $resource_def->{'handler'} ) eq 'HASH' )
186 480         1044 ? keys( %{ $resource_def->{'handler'} } )
187 700 50       1430 : @{ $site->MREST_SUPPORTED_HTTP_METHODS || [ qw( GET POST PUT DELETE ) ] };
  220 100       1338  
188 700         7304 foreach my $method ( @supported_methods ) {
189             #$log->debug( "Considering the \"$method\" method" );
190 2140 50       3051 if ( exists $resource_def->{$prop} ) {
191 2140         2693 my $prop_def = $resource_def->{$prop};
192 2140   100     4715 my $refv = ref( $prop_def ) || 'SCALAR';
193             #$log->debug( "The definition of this property is a $refv" );
194 2140 100       3521 if ( $refv eq 'HASH' ) {
    50          
195 320 50       563 if ( $prop_def->{$method} ) {
196 320         793 $resources->{$resource}->{$method}->{$prop} = $prop_def->{$method};
197             } else {
198 0         0 $log->crit( "No $prop defined for $method method in $resource!" );
199             }
200             } elsif ( $refv eq 'SCALAR' ) {
201 1820         4160 $resources->{$resource}->{$method}->{$prop} = $prop_def;
202             } else {
203 0           die "AAAAAGAAAGAAAAAA! in " . __FILE__ . ", _populate_resources";
204             }
205             } else {
206             # resource with no def_part: suspicious
207 0           $log->notice( "While walking resource definition tree, " .
208             "encountered resource $resource with missing $prop in its definition" );
209             }
210             }
211             }
212              
213             1;