File Coverage

blib/lib/OTRS/OPM/Validate.pm
Criterion Covered Total %
statement 114 179 63.6
branch 9 18 50.0
condition 7 8 87.5
subroutine 7 7 100.0
pod 1 1 100.0
total 138 213 64.7


line stmt bran cond sub pod time code
1             package OTRS::OPM::Validate;
2             $OTRS::OPM::Validate::VERSION = '0.05';
3             # ABSTRACT: Validate .opm files - DEPRECATED
4              
5 1     1   781 use v5.20;
  1         11  
6              
7 1     1   7 use strict;
  1         2  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         1044  
9              
10             my %boundaries = (
11             # tag min max
12             CVS => [ 0, 1],
13             Name => [ 1, 1],
14             URL => [ 1, 1],
15             Vendor => [ 1, 1],
16             Version => [ 1, 1],
17             BuildDate => [ 0, 1],
18             BuildHost => [ 0, 1],
19             );
20              
21             sub validate {
22 7     7 1 6357 my ($class, $content) = @_;
23              
24 7         73 $content =~ s{
25            
26             }{}xmsg;
27              
28 7         18 my ($check,$grammar) = _grammar( $content );
29 7         197 my $match = $content =~ $grammar;
30 7 100       33 die 'Invalid .opm file' if !$match;
31              
32 6         22 for my $key ( keys %boundaries ) {
33 42         63 $check->( $key );
34             }
35             }
36              
37             sub _grammar {
38 7     7   13 my ($content) = @_;
39              
40 7         11 my %s;
41              
42             my $check = sub {
43 380     380   983 my ($name, $max, $min) = @_;
44              
45 380 100 66     828 $max //= (exists $boundaries{$name} ? $boundaries{$name}->[-1] : 100_000);
46 380 100 100     956 $min //= (exists $boundaries{$name} ? $boundaries{$name}->[0] : 0);
47              
48 380   100     661 $s{$name} //= 0;
49              
50 380         486 my $context = '';
51             # my $pos = pos();
52             # if ( $pos ) {
53             # my $start_length = 30;
54             # my $start = $pos - $start_length;
55             # if ( $start < 0 ) {
56             # $start_length = $pos;
57             # $start = 0;
58             # }
59             #
60             # my $end_length = 30;
61             # if ( $pos + $end_length > length $content ) {
62             # $end_length = ( length $content ) - $pos;
63             # }
64             #
65             # $context = sprintf "\n%s <-- --> %s",
66             # ( substr $content, $start, $start_length ),
67             # ( substr $content, $pos, $end_length );
68             # }
69              
70 380 50       4163 if ( $s{$name} > $max ) {
    50          
71 0         0 die sprintf 'Too many "%s" elements. Max %s element(s) allowed.%s', $name, $max, $context;
72             }
73             elsif ( $s{$name} < $min ) {
74 0         0 die sprintf 'Too few "%s" elements. Min %s element(s) required.%s', $name, $min, $context;
75             }
76 7         41 };
77              
78             my $grammar = qr{
79             \A(?&PACKAGE)\z
80              
81             (?(DEFINE)
82             (?
83             \s* <\?xml \s* version="1.0" \s* encoding="[^"]+?" \s* \?> \s+
84             \s* <(?otrs|otobo)_package \s+ version="[12].[0-9]+">
85             (?:\s*(?&PACKAGE_TAGS))+
86             \s* \s*
87             )
88              
89             (?
90 4         27 (?:.*?(?{$s{CVS}++; $check->('CVS')})) |
  4         10  
91 7         20 (?:.*?(?{++$s{Name}; $check->('Name')})) |
  7         14  
92 7         18 (?:.*?(?{++$s{Version}; $check->('Version')})) |
  7         11  
93 6         14 (?:.*?(?{++$s{Vendor}; $check->('Vendor')})) |
  6         10  
94 6         16 (?:.*?(?{++$s{URL}; $check->('URL')})) |
  6         17  
95 4         9 (?:.*?(?{++$s{License}; $check->('License')})) |
  4         17  
96 4         14 (?:.*?(?{$s{BuildDate}++; $check->('BuildDate')})) |
  4         6  
97 4         10 (?:.*?(?{$s{BuildHost}++; $check->('BuildHost')})) |
  4         7  
98             (?:.*?) |
99             (?&FRAMEWORK) |
100             (?&DESCRIPTION) |
101             (?&INTRO) |
102             (?&CODE) |
103             (?&PACKAGEMERGE) |
104             (?&PREREQ) |
105             (?&FILELIST) |
106             (?&DATABASE) |
107             (?&CHANGELOG)
108             )
109              
110             (?
111 10         170 .*?
112             )
113              
114             (?
115 2         5 (?:Maximum=".*?"(?{++$s{'Framework.Max'}; $check->('Framework.Max',1)})) |
  2         4  
116 2         3 (?:Minimum=".*?"(?{++$s{'Framework.Min'}; $check->('Framework.Min',1)}))
  2         4  
117             )
118              
119             (?
120             .*?
121             )
122              
123             (?
124 15         29 (?:Lang="(?[a-zA-Z]+)"(?{++$s{'Description.Lang'}; $check->('Description.Lang',1)})) |
  15         26  
125 0         0 (?:Format="[a-zA-Z]+"(?{++$s{'Description.Format'}; $check->('Description.Format',1)})) |
  0         0  
126 0         0 (?:Translatable="[01]"(?{++$s{'Description.Translatable'}; $check->('Description.Translatable',1)}))
  0         0  
127             )
128              
129             (?
130 6         13
131             ( \s+ (?&CHANGELOG_ATTR))+>.*?
132 6         16 (?{$check->('ChangeLog.Date', 1, 1); $check->('ChangeLog.Version', 1, 1); })
  6         10  
133             )
134              
135             (?
136 6         12 (?:Date=".*?"(?{++$s{'ChangeLog.Date'}; $check->('ChangeLog.Date',1,1)})) |
  6         10  
137 6         14 (?:Version=".*?"(?{++$s{'ChangeLog.Version'}; $check->('ChangeLog.Version',1,1)}))
  6         11  
138             )
139              
140             (?
141 2         5 Install|Upgrade|Reinstall|Uninstall) (?{delete @s{map{'Intro.'. $_}qw/Type Lang Title Translatable Version Format/};})
  12         33  
142             ( \s+ (?&INTRO_ATTR))+>.*?
143 2         4 (?{$check->('Intro.Type', 1, 1);})
144             )
145              
146             (?
147 2         6 (?:Type="(?i:Post|Pre)"(?{++$s{'Intro.Type'}; $check->('Intro.Type',1,1)})) |
  2         5  
148 0         0 (?:Title=".*?"(?{++$s{'Intro.Title'}; $check->('Intro.Title',1)})) |
  0         0  
149 0         0 (?:Format=".*?"(?{++$s{'Intro.Format'}; $check->('Intro.Format',1)})) |
  0         0  
150 0         0 (?:Lang="[A-Za-z]+"(?{++$s{'Intro.Lang'}; $check->('Intro.Lang',1)})) |
  0         0  
151 0         0 (?:Translatable="[01]"(?{++$s{'Intro.Translatable'}; $check->('Intro.Translatable',1)})) |
  0         0  
152 1 0   1   674 (?:Version=".*?"(?{++$s{'Intro.Version'}; $check->('Intro.Version',$+{intro_type} eq 'Upgrade' ? 1 : 0)}))
  1         547  
  1         2497  
  0         0  
  0         0  
153             )
154            
155             (?
156 0         0 Install|Upgrade|Reinstall|Uninstall) (?{delete @s{map{'Code.'. $_}qw/Type Version/};})
  0         0  
157             ( \s+ (?&CODE_ATTR))+>.*?
158 0         0 (?{$check->('Code.Type', 1, 1);})
159             )
160              
161             (?
162 0         0 (?:Type="(?i:Post|Pre)"(?{++$s{'Code.Type'}; $check->('Code.Type',1,1)})) |
  0         0  
163 0 0       0 (?:Version=".*?"(?{++$s{'Code.Version'}; $check->('Code.Version',$+{code_type} eq 'Upgrade' ? 1 : 0)}))
  0         0  
164             )
165              
166             (?
167             <(?Module|Package)Required (?{delete $s{'Prereq.Version'};})
168             (\s+ (?&VERSION))?>.*?
169 3         7 (?{$check->('Prereq.Version', 1);})
170             )
171              
172             (?
173 3         7 (?:Version=".*?"(?{++$s{'Prereq.Version'}; $check->('Prereq.Version', 1)}))
  3         6  
174             )
175              
176             (?
177            
178             (\s+ (?&PACKAGEMERGEATTR))+>.*?
179 1         3 (?{$check->('Merge.Name', 1, 1);})
180             )
181              
182             (?
183 1         4 (?:TargetVersion=".*?"(?{++$s{'Merge.Version'}; $check->('Merge.Version', 1)})) |
  1         2  
184 1         5 (?:Name=".*?"(?{++$s{'Merge.Name'};}))
185             )
186              
187              
188             (?
189             (\s*(?&FILE))+\s*
190             )
191              
192             (?
193 34         105
  102         510  
194             ( \s+ (?&FILE_ATTR))+>.*?
195 34         116 (?{$check->('File.' . $_ , 1, 1) for qw/Location Permission Encode/;})
196             )
197              
198             (?
199 34         240 (?:Location=".*?"(?{++$s{'File.Location'};})) |
200 34         359 (?:Encode=".*?"(?{++$s{'File.Encode'};})) |
201 34         337 (?:Permission=".*?"(?{++$s{'File.Permission'};}))
202             )
203              
204             (?
205 6         16 Install|Upgrade|Reinstall|Uninstall) (?{delete @s{map{'Database.'. $_}qw/Type Version/};})
  12         73  
206             ( \s+ (?&DATABASE_ATTR)){0,3}>
207             (\s* (?&DATABASE_TAGS) )+ \s*
208            
209             )
210              
211             (?
212 3         12 (?:Type="(?i:Post|Pre)"(?{++$s{'Database.Type'}; $check->('Database.Type',1)})) |
  3         7  
213 0 0       0 (?:Version=".*?"(?{++$s{'Database.Version'}; $check->('Database.Version',$+{database_type} eq 'Upgrade' ? 1 : 0)}))
  0         0  
214             )
215              
216             (?
217             (?&TABLE_CREATE) |
218             (?&TABLE_DROP) |
219             (?&TABLE_ALTER) |
220             (?&INSERT)
221             )
222              
223             (?
224 2         8
  6         21  
225             ( \s+ (?&TABLE_ATTR))+>
226             (\s* (?&TABLE_CREATE_TAGS) )+ \s*
227            
228             )
229              
230             (?
231             (?&COLUMN) |
232             (?&FOREIGN_KEY) |
233             (?&INDEX) |
234             (?&UNIQUE)
235             )
236              
237             (?
238 6         17
  18         67  
239             ( \s+ (?&TABLE_ATTR))+>
240             (\s* (?&TABLE_ALTER_TAGS) )+ \s*
241            
242             )
243              
244             (?
245             (?&COLUMN_ADD) |
246             (?&COLUMN_DROP) |
247             (?&COLUMN_CHANGE) |
248             (?&FOREIGN_KEY_CREATE) |
249             (?&FOREIGN_KEY_DROP) |
250             (?&INDEX_CREATE) |
251             (?&INDEX_DROP) |
252             (?&UNIQUE_CREATE) |
253             (?&UNIQUE_DROP)
254             )
255              
256             (?
257 2         6
  6         21  
258             ( \s+ (?&TABLE_ATTR))+ (?:/>|>\s*)
259             )
260              
261             (?
262 10         26 (?:Name=".*?"(?{++$s{'Table.Name'}; $check->('Table.Name',1,1)})) |
  10         18  
263 0         0 (?:Type="(?i:Post|Pre)"(?{++$s{'Table.Type'}; $check->('Table.Type',1)})) |
  0         0  
264 6 50       18 (?:Version=".*?"(?{++$s{'Table.Version'}; $check->('Table.Version',$+{database_type} eq 'Upgrade' ? 1 : 0)}))
  6         49  
265             )
266              
267             (?
268 24         74
  168         451  
269             ( \s+ (?&COLUMN_ATTR))+ (?:/>|>\s*)
270             )
271              
272             (?
273 6         27
  42         136  
274             ( \s+ (?&COLUMN_ATTR))+ (?:/>|>\s*)
275             )
276              
277             (?
278 30         87 (?:Name=".*?"(?{++$s{'Column.Name'}; $check->('Column.Name',1,1)})) |
  30         49  
279 2         7 (?:AutoIncrement="(?:true|false)"(?{++$s{'Column.AutoIncrement'}; $check->('Column.AutoIncrement',1)})) |
  2         4  
280 30         75 (?:Required="(?:true|false)"(?{++$s{'Column.Required'}; $check->('Column.Required',1)})) |
  30         52  
281 2         9 (?:PrimaryKey="(?:true|false)"(?{++$s{'Column.PrimaryKey'}; $check->('Column.PrimaryKey',1)})) |
  2         4  
282 30         73 (?:Type=".*?"(?{++$s{'Column.Type'}; $check->('Column.Type',1)})) |
  30         51  
283 10         27 (?:Size="\d+"(?{++$s{'Column.Size'}; $check->('Column.Size',1)})) |
  10         16  
284 0         0 (?:Default=".*?"(?{++$s{'Column.Default'}; $check->('Column.Default',1)}))
  0         0  
285             )
286              
287             (?
288 0         0
  0         0  
289             ( \s+ (?&COLUMN_CHANGE_ATTR))+ (?:/>|>\s*)
290             )
291              
292             (?
293 0         0 (?:NameOld=".*?"(?{++$s{'Column.NameOld'}; $check->('Column.NameOld',1)})) |
  0         0  
294 0         0 (?:NameNew=".*?"(?{++$s{'Column.NameNew'}; $check->('Column.NameNew',1)})) |
  0         0  
295 0         0 (?:AutoIncrement="(?:true|false)"(?{++$s{'Column.AutoIncrement'}; $check->('Column.AutoIncrement',1)})) |
  0         0  
296 0         0 (?:Required="(?:true|false)"(?{++$s{'Column.Required'}; $check->('Column.Required',1)})) |
  0         0  
297 0         0 (?:PrimaryKey="(?:true|false)"(?{++$s{'Column.PrimaryKey'}; $check->('Column.PrimaryKey',1)})) |
  0         0  
298 0         0 (?:Type=".*?"(?{++$s{'Column.Type'}; $check->('Column.Type',1)})) |
  0         0  
299 0         0 (?:Size="\d+"(?{++$s{'Column.Size'}; $check->('Column.Size',1)})) |
  0         0  
300 0         0 (?:Default=".*?"(?{++$s{'Column.Default'}; $check->('Column.Default',1)}))
  0         0  
301             )
302              
303             (?
304            
305             ( \s+ (?&COLUMN_ATTR))+ (?:/>|>\s*)
306             )
307              
308             (?
309 0         0 (?:Name=".*?"(?{++$s{'Column.Name'}; $check->('Column.Name',1,1)}))
  0         0  
310             )
311              
312             (?
313 0         0
  0         0  
314             ( \s+ (?&INSERT_ATTR))+>
315             (\s+ (?&INSERT_DATA) )+ \s*
316            
317             )
318              
319             (?
320 0         0 (?:Table=".*?"(?{++$s{'Insert.Table'}; $check->('Insert.Table',1,1)})) |
  0         0  
321 0         0 (?:Type=".*?"(?{++$s{'Insert.Type'}; $check->('Insert.Type',1)})) |
  0         0  
322 0         0 (?:Version=".*?"(?{++$s{'Insert.Version'}; $check->('Insert.Version',1)}))
  0         0  
323             )
324              
325             (?
326 0         0
  0         0  
327             ( \s+ (?&INSERT_DATA_ATTR))+>
328             .*?
329            
330             )
331              
332             (?
333 0         0 (?:Key=".*?"(?{++$s{'Data.Key'}; $check->('Data.Key',1,1)})) |
  0         0  
334 0         0 (?:Type=".*?"(?{++$s{'Data.Type'}; $check->('Data.Type',1)}))
  0         0  
335             )
336              
337             (?
338            
339             (\s+ (?&INDEX_COLUMN) )+ \s*
340            
341             )
342              
343             (?
344            
345             ( \s+ (?&NAME_ATTR))? (?:/>|>\s*)
346             )
347              
348             (?
349            
350             ( \s+ (?&NAME_ATTR))? (?:/>|>\s*)
351             )
352              
353             (?
354            
355             ( \s+ (?&NAME_ATTR))? (?:/>|>\s*)
356             )
357              
358             (?
359            
360             (\s+ (?&UNIQUE_COLUMN) )+ \s*
361            
362             )
363              
364             (?
365            
366             ( \s+ (?&NAME_ATTR))? (?:/>|>\s*)
367             )
368              
369             (?
370            
371             ( \s+ (?&NAME_ATTR))? (?:/>|>\s*)
372             )
373              
374             (?
375             |>\s*)
376             )
377              
378             (?
379 0         0 (?:Name=".*?"(?{++$s{'Generic.Name'}; $check->('Generic.Name',1,1)}))
  0         0  
380             )
381            
382             (?
383            
384             (\s+ (?&REFERENCE) )+ \s*
385            
386             )
387              
388             (?
389            
390             ( \s+ (?&NAME_ATTR))? (?:/>|>\s*)
391             )
392              
393             (?
394             |>\s*)
395             )
396              
397             (?
398 4         11 (?:ForeignTable=".*?"(?{++$s{'ForeignTable'}; $check->('ForeignTable',1,1)}))
  4         8  
399             )
400              
401             (?
402 6         73
403             ( \s+ (?&REFERENCE_ATTR) )+ \s*
404             (?:\s*/>|>\s*)
405             )
406              
407             (?
408 6         16 (?:Local=".*?"(?{++$s{'Reference.Local'}; $check->('Reference.Local',1,1)})) |
  6         11  
409 6         15 (?:Foreign=".*?"(?{++$s{'Reference.Foreign'}; $check->('Reference.Foreign',1,1)}))
  6         10  
410             )
411             )
412 7         68 }xms;
413              
414 7         21 return $check, $grammar;
415             }
416              
417             1;
418              
419             __END__