1 | ###########################################################################
|
---|
2 | # A module to handle XML descriptors
|
---|
3 | #
|
---|
4 | # Copyright (C) 2016-2018 Andrey Ponomarenko's ABI Laboratory
|
---|
5 | #
|
---|
6 | # Written by Andrey Ponomarenko
|
---|
7 | #
|
---|
8 | # This library is free software; you can redistribute it and/or
|
---|
9 | # modify it under the terms of the GNU Lesser General Public
|
---|
10 | # License as published by the Free Software Foundation; either
|
---|
11 | # version 2.1 of the License, or (at your option) any later version.
|
---|
12 | #
|
---|
13 | # This library is distributed in the hope that it will be useful,
|
---|
14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
---|
16 | # Lesser General Public License for more details.
|
---|
17 | #
|
---|
18 | # You should have received a copy of the GNU Lesser General Public
|
---|
19 | # License along with this library; if not, write to the Free Software
|
---|
20 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
|
---|
21 | # MA 02110-1301 USA.
|
---|
22 | ###########################################################################
|
---|
23 | use strict;
|
---|
24 |
|
---|
25 | sub createDesc($$)
|
---|
26 | {
|
---|
27 | my ($Path, $LVer) = @_;
|
---|
28 |
|
---|
29 | if(not -e $Path) {
|
---|
30 | return undef;
|
---|
31 | }
|
---|
32 |
|
---|
33 | if(-d $Path or $Path=~/\.(jar|jmod)\Z/)
|
---|
34 | {
|
---|
35 | return "
|
---|
36 | <version>
|
---|
37 | ".$In::Desc{$LVer}{"TargetVersion"}."
|
---|
38 | </version>
|
---|
39 |
|
---|
40 | <archives>
|
---|
41 | $Path
|
---|
42 | </archives>";
|
---|
43 | }
|
---|
44 |
|
---|
45 | # standard XML-descriptor
|
---|
46 | return readFile($Path);
|
---|
47 | }
|
---|
48 |
|
---|
49 | sub readDesc($$)
|
---|
50 | {
|
---|
51 | my ($Content, $LVer) = @_;
|
---|
52 |
|
---|
53 | if(not $Content) {
|
---|
54 | exitStatus("Error", "XML descriptor is empty");
|
---|
55 | }
|
---|
56 |
|
---|
57 | if($Content!~/\</) {
|
---|
58 | exitStatus("Error", "descriptor should be one of the following: Java archive, XML descriptor, API dump or directory with Java archives.");
|
---|
59 | }
|
---|
60 |
|
---|
61 | $Content=~s/\/\*(.|\n)+?\*\///g;
|
---|
62 | $Content=~s/<\!--(.|\n)+?-->//g;
|
---|
63 | $In::Desc{$LVer}{"Version"} = parseTag(\$Content, "version");
|
---|
64 |
|
---|
65 | if(defined $In::Desc{$LVer}{"TargetVersion"}) {
|
---|
66 | $In::Desc{$LVer}{"Version"} = $In::Desc{$LVer}{"TargetVersion"};
|
---|
67 | }
|
---|
68 |
|
---|
69 | if($In::Desc{$LVer}{"Version"} eq "") {
|
---|
70 | exitStatus("Error", "version in the XML descriptor is not specified (<version> section)");
|
---|
71 | }
|
---|
72 |
|
---|
73 | if(my $Archives = parseTag(\$Content, "archives"))
|
---|
74 | {
|
---|
75 | foreach my $Path (split(/\s*\n\s*/, $Archives))
|
---|
76 | {
|
---|
77 | if(not -e $Path) {
|
---|
78 | exitStatus("Access_Error", "can't access \'$Path\'");
|
---|
79 | }
|
---|
80 | $Path = getAbsPath($Path);
|
---|
81 | $In::Desc{$LVer}{"Archives"}{$Path} = 1;
|
---|
82 | }
|
---|
83 | }
|
---|
84 | else {
|
---|
85 | exitStatus("Error", "descriptor does not contain info about Java archives");
|
---|
86 | }
|
---|
87 |
|
---|
88 | foreach my $Package (split(/\s*\n\s*/, parseTag(\$Content, "skip_packages"))) {
|
---|
89 | $In::Desc{$LVer}{"SkipPackages"}{$Package} = 1;
|
---|
90 | }
|
---|
91 | foreach my $Package (split(/\s*\n\s*/, parseTag(\$Content, "packages"))) {
|
---|
92 | $In::Desc{$LVer}{"KeepPackages"}{$Package} = 1;
|
---|
93 | }
|
---|
94 | }
|
---|
95 |
|
---|
96 | return 1;
|
---|