File Coverage

blib/lib/YAML/PP/Schema/Include.pm
Criterion Covered Total %
statement 80 86 93.0
branch 25 30 83.3
condition 2 4 50.0
subroutine 14 15 93.3
pod 0 9 0.0
total 121 144 84.0


line stmt bran cond sub pod time code
1 2     2   163395 use strict;
  2         4  
  2         58  
2 2     2   7 use warnings;
  2         2  
  2         158  
3             package YAML::PP::Schema::Include;
4              
5             our $VERSION = 'v0.39.0'; # VERSION
6              
7 2     2   7 use Carp qw/ croak /;
  2         3  
  2         97  
8 2     2   11 use Scalar::Util qw/ weaken /;
  2         4  
  2         60  
9 2     2   8 use File::Basename qw/ dirname /;
  2         3  
  2         1551  
10              
11             sub new {
12 4     4 0 196374 my ($class, %args) = @_;
13              
14 4         8 my $paths = delete $args{paths};
15 4 100       10 if (defined $paths) {
16 2 50       8 unless (ref $paths eq 'ARRAY') {
17 2         3 $paths = [$paths];
18             }
19             }
20             else {
21 2         3 $paths = [];
22             }
23 4   50     18 my $allow_absolute = $args{allow_absolute} || 0;
24 4   50     14 my $loader = $args{loader} || \&default_loader;
25              
26 4         19 my $self = bless {
27             paths => $paths,
28             allow_absolute => $allow_absolute,
29             last_includes => [],
30             cached => {},
31             loader => $loader,
32             }, $class;
33 4         11 return $self;
34             }
35              
36             sub init {
37 0     0 0 0 my ($self) = @_;
38 0         0 $self->{last_includes} = [];
39 0         0 $self->{cached} = [];
40             }
41              
42 11     11 0 15 sub paths { $_[0]->{paths} }
43 11     11 0 15 sub allow_absolute { $_[0]->{allow_absolute} }
44             sub yp {
45 15     15 0 35 my ($self, $yp) = @_;
46 15 100       31 if (@_ == 2) {
47 4         9 $self->{yp} = $yp;
48 4         11 weaken $self->{yp};
49 4         11 return $yp;
50             }
51 11         14 return $self->{yp};
52             }
53              
54             sub register {
55 4     4 0 10 my ($self, %args) = @_;
56 4         7 my $schema = $args{schema};
57              
58             $schema->add_resolver(
59             tag => '!include',
60 4     11   21 match => [ all => sub { $self->include(@_) } ],
  11         36  
61             implicit => 0,
62             );
63             }
64              
65             sub include {
66 11     11 0 15 my ($self, $constructor, $event) = @_;
67 11         19 my $yp = $self->yp;
68 11         23 my $search_paths = $self->paths;
69 11         21 my $allow_absolute = $self->allow_absolute;
70              
71 11         15 my $relative = not @$search_paths;
72 11 100       28 if ($relative) {
73 6         10 my $last_includes = $self->{last_includes};
74 6 100       13 if (@$last_includes) {
75 3         7 $search_paths = [ $last_includes->[-1] ];
76             }
77             else {
78             # we are in the top-level file and need to look into
79             # the original YAML::PP instance
80 3         10 my $filename = $yp->loader->filename;
81 3         140 $search_paths = [dirname $filename];
82             }
83             }
84 11         16 my $filename = $event->{value};
85              
86 11         12 my $fullpath;
87 11 100       116 if (File::Spec->file_name_is_absolute($filename)) {
88 1 50       4 unless ($allow_absolute) {
89 1         100 croak "Absolute filenames not allowed";
90             }
91 0         0 $fullpath = $filename;
92             }
93             else {
94 10         54 my @paths = File::Spec->splitdir($filename);
95 10 50       21 unless ($allow_absolute) {
96             # if absolute paths are not allowed, we also may not use upwards ..
97 10         71 @paths = File::Spec->no_upwards(@paths);
98             }
99 10         18 for my $candidate (@$search_paths) {
100 10         104 my $test = File::Spec->catfile( $candidate, @paths );
101 10 100       514 if (-e $test) {
102 9         14 $fullpath = $test;
103 9         18 last;
104             }
105             }
106 10 100       224 croak "File '$filename' not found" unless defined $fullpath;
107             }
108              
109 9 100       34 if ($self->{cached}->{ $fullpath }++) {
110 1         154 croak "Circular include '$fullpath'";
111             }
112 8 100       13 if ($relative) {
113 5         6 push @{ $self->{last_includes} }, dirname $fullpath;
  5         157  
114             }
115              
116             # We need a new object because we are still in the parsing and
117             # constructing process
118 8         33 my $clone = $yp->clone;
119 8         17 my ($data) = $self->loader->($clone, $fullpath);
120              
121 6 100       11 if ($relative) {
122 3         4 pop @{ $self->{last_includes} };
  3         5  
123             }
124 6 50       16 unless (--$self->{cached}->{ $fullpath }) {
125 6         11 delete $self->{cached}->{ $fullpath };
126             }
127 6         33 return $data;
128             }
129              
130             sub loader {
131 8     8 0 18 my ($self, $code) = @_;
132 8 50       15 if (@_ == 2) {
133 0         0 $self->{loader} = $code;
134 0         0 return $code;
135             }
136 8         17 return $self->{loader};
137             }
138             sub default_loader {
139 8     8 0 11 my ($yp, $filename) = @_;
140 8         22 $yp->load_file($filename);
141             }
142              
143             1;
144              
145             __END__
146              
147             =pod
148              
149             =encoding utf-8
150              
151             =head1 NAME
152              
153             YAML::PP::Schema::Include - Include YAML files
154              
155             =head1 SYNOPSIS
156              
157             # /path/to/file.yaml
158             # ---
159             # included: !include include/file2.yaml
160              
161             # /path/to/include/file2.yaml
162             # ---
163             # a: b
164              
165             my $include = YAML::PP::Schema::Include->new;
166              
167             my $yp = YAML::PP->new( schema => ['+', $include] );
168             # we need the original YAML::PP object for getting the current filename
169             # and for loading another file
170             $include->yp($yp);
171              
172             my ($data) = $yp->load_file("/path/to/file.yaml");
173              
174             # The result will be:
175             $data = {
176             included => { a => 'b' }
177             };
178              
179             Allow absolute filenames and upwards C<'..'>:
180              
181             my $include = YAML::PP::Schema::Include->new(
182             allow_absolute => 1, # default: 0
183             );
184              
185             Specify paths to search for includes:
186              
187             my @include_paths = ("/path/to/include/yaml/1", "/path/to/include/yaml/2");
188             my $include = YAML::PP::Schema::Include->new(
189             paths => \@include_paths,
190             );
191             my $yp = YAML::PP->new( schema => ['+', $include] );
192             $include->yp($yp);
193              
194             # /path/to/include/yaml/1/file1.yaml
195             # ---
196             # a: b
197              
198             my $yaml = <<'EOM';
199             - included: !include file1.yaml
200             EOM
201             my ($data) = $yp->load_string($yaml);
202              
203              
204             =head1 DESCRIPTION
205              
206             This plugin allows you to split a large YAML file into smaller ones.
207             You can then include these files with the C<!include> tag.
208              
209             It will search for the specified filename relative to the currently processed
210             filename.
211              
212             You can also specify the paths where to search for files to include. It iterates
213             through the paths and returns the first filename that exists.
214              
215             By default, only relative paths are allowed. Any C<../> in the path will be
216             removed. You can change that behaviour by setting the option C<allow_absolute>
217             to true.
218              
219             If the included file contains more than one document, only the first one
220             will be included.
221              
222             I will probably add a possibility to return all documents as an arrayref.
223              
224             The included YAML file will be loaded by creating a new L<YAML::PP> object
225             with the schema from the existing object. This way you can recursively include
226             files.
227              
228             You can even reuse the same include via an alias:
229              
230             ---
231             invoice:
232             shipping address: &address !include address.yaml
233             billing address: *address
234              
235             Circular includes will be detected, and will be fatal.
236              
237             It's possible to specify what to do with the included file:
238              
239             my $include = YAML::PP::Schema::Include->new(
240             loader => sub {
241             my ($yp, $filename);
242             if ($filename =~ m/\.txt$/) {
243             # open file and just return text
244             }
245             else {
246             # default behaviour
247             return $yp->load_file($filename);
248             }
249             },
250             );
251              
252             For example, RAML defines an C<!include> tag which depends on the file
253             content. If it contains a special RAML directive, it will be loaded as
254             YAML, otherwise the content of the file will be included as a string.
255              
256             So with this plugin you are able to read RAML specifications.
257              
258              
259             =cut