File Coverage

blib/lib/CAD/Firemen/Load.pm
Criterion Covered Total %
statement 15 115 13.0
branch 0 42 0.0
condition 0 12 0.0
subroutine 5 9 55.5
pod 3 3 100.0
total 23 181 12.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             ######################
3             #
4             # Copyright (C) 2011 TU Clausthal, Institut fuer Maschinenwesen, Joachim Langenbach
5             #
6             # This program is free software: you can redistribute it and/or modify
7             # it under the terms of the GNU General Public License as published by
8             # the Free Software Foundation, either version 3 of the License, or
9             # (at your option) any later version.
10             #
11             # This program is distributed in the hope that it will be useful,
12             # but WITHOUT ANY WARRANTY; without even the implied warranty of
13             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14             # GNU General Public License for more details.
15             #
16             # You should have received a copy of the GNU General Public License
17             # along with this program. If not, see .
18             #
19             ######################
20              
21             # Pod::Weaver infos
22             # ABSTRACT: Module to parse files from Firemen (like pro and cdb files)
23              
24 1     1   5 use strict;
  1         1  
  1         24  
25 1     1   4 use warnings;
  1         2  
  1         44  
26              
27             package CAD::Firemen::Load;
28             {
29             $CAD::Firemen::Load::VERSION = '0.7.0';
30             }
31 1     1   4 use Exporter 'import';
  1         2  
  1         38  
32             our @EXPORT_OK = qw(loadConfig loadCDB loadDatabase);
33 1     1   4 use POSIX;
  1         2  
  1         10  
34 1     1   2453 use CAD::Firemen::Common qw(strip printColored);
  1         2  
  1         920  
35              
36              
37             sub loadConfig {
38 0     0 1   my $cfgUrl = shift;
39 0           my $CFG;
40 0           my %options= ();
41 0           my %errors = ();
42              
43 0 0 0       if(!defined($cfgUrl) || $cfgUrl eq ""){
44 0           $errors{0} = "No URL given";
45 0           return (\%options, \%errors, 0);
46             }
47              
48             # Get all possible options listed within the cdb file
49 0 0         if(!open($CFG, "<", $cfgUrl)){
50 0           $errors{0} = "Could not open file! (". $cfgUrl .")";
51 0           return (\%options, \%errors, 0);
52             }
53              
54 0           my $i = 0;
55 0           while(<$CFG>){
56 0           my $line = strip($_);
57 0           $i++;
58             # skip comments and mapkeys
59 0 0         if($line !~ m/^\s*!/){
60 0 0         if($line =~ m/^\s*mapkey/){
61             # handle mapkeys here
62             }
63             else{
64 0 0         if($line =~ m/^([^\s]+)\s+([^!]+)/){
65 0           my $opt = uc($1);
66 0 0         if(!exists($options{$opt})){
67 0           $options{$opt} = {};
68             }
69 0           $options{$opt}->{strip($i)} = strip($2);
70             }
71             else{
72 0 0         if($line ne ""){
73 0           $errors{$i} = "Detected uncommented line without an option";
74             }
75             }
76             }
77             }
78             }
79              
80 0           close($CFG);
81              
82 0           return (\%options, \%errors, $i);
83             }
84              
85             sub loadCDB {
86 0     0 1   my $cdbUrl = shift;
87 0           my $CDB;
88 0           my %results = ();
89 0           my %errors = ();
90              
91 0 0 0       if(!defined($cdbUrl) || $cdbUrl eq ""){
92 0           $errors{0} = "No URL given";
93 0           return (\%results, \%errors);
94             }
95              
96             # Get all possible options listed within the cdb file
97 0 0         if(!open($CDB, "<", $cdbUrl)){
98 0           $errors{0} = "Could not open file! (". $cdbUrl .")";
99 0           return (\%results, \%errors);
100             }
101              
102 0           my $i = 1;
103 0           while(<$CDB>){
104 0           my $line = strip($_);
105 0 0         if($line =~ m/^([^\s]+)\s{0,}\( -[\w\d]+\s{0,}\)/){
106 0           my $ref;
107 0           my $error = "";
108 0           my $lineNumber = $i;
109 0           ($ref, $i, $error) = _extractParameters($CDB, $i);
110 0           $results{uc($1)} = { $lineNumber => $ref };
111 0 0         if($error ne ""){
112 0           $errors{$i} = $error;
113             }
114             # this can not be treated as an error, because many options does not have values supplied
115             #if(scalar(@opts) < 1){
116             # $errors{$i} = "WARNING: Could not get a list of parameters for option ". $1;
117             #}
118             }
119 0           $i++;
120             }
121              
122 0           close($CDB);
123              
124 0           return (\%results, \%errors);
125             }
126              
127             sub loadDatabase {
128 0     0 1   my $dbh = shift;
129 0           my $sqlQuery = shift;
130 0           my $verbose = shift;
131              
132 0           my %options = ();
133 0           my %errors = ();
134 0           my %descriptions = ();
135              
136 0 0         if(!defined($verbose)){
137 0           $verbose = 0;
138             }
139 0 0         if(!$dbh){
140 0           $errors{0} = "No database handle given";
141 0           return (\%options, \%errors, \%descriptions);
142             }
143 0 0 0       if(!defined($sqlQuery) || ($sqlQuery eq "")){
144 0           $errors{0} = "No SQL Query string given";
145 0           return (\%options, \%errors, \%descriptions);
146             }
147 0           my $ref = $dbh->selectall_hashref($sqlQuery, 'name');
148 0 0         if(!$ref){
149 0           $errors{0} = "Error ". $dbh->err ." (". $dbh->errstr .")";
150 0           return (\%options, \%errors, \%descriptions);
151             }
152 0           my %results = %{$ref};
  0            
153 0           foreach my $name (keys(%results)){
154 0           $sqlQuery = "SELECT vals.id as id, vals.name as name FROM options_values as vals, options_has_values opthasvals";
155 0           $sqlQuery .= " WHERE vals.id=opthasvals.valuesId";
156 0           $sqlQuery .= " AND opthasvals.optionsId=". $results{$name}->{"id"};
157 0           $ref = $dbh->selectall_hashref($sqlQuery, "id");
158 0 0         if(!defined($ref)){
159 0           next;
160             }
161 0           my %tmpValues = ();
162 0           foreach my $valId (keys(%{$ref})){
  0            
163 0           $tmpValues{$ref->{$valId}->{"name"}} = 0;
164 0 0 0       if(defined($results{$name}->{"defaultValueId"}) && ($valId == $results{$name}->{"defaultValueId"})){
165 0           $tmpValues{$ref->{$valId}->{"name"}} = 1;
166             }
167             }
168             # we use line 0 here, because we do not know the line
169 0           $options{$name} = { 0 => \%tmpValues};
170 0           $descriptions{$name} = $results{$name}->{"description"};
171             }
172              
173 0           return (\%options, \%errors, \%descriptions);
174             }
175              
176             sub _extractParameters {
177 0     0     my $CDB = shift;
178             # the line number
179 0           my $i = shift;
180 0           my $start = 0;
181 0           my %values = ();
182 0           while(<$CDB>){
183             # raise it here, because we have read a new line already
184 0           $i++;
185 0           my $line = strip($_);
186 0 0         if($line eq "{"){
    0          
    0          
187 0           $start = 1;
188             }
189             elsif($line eq "}"){
190 0 0         if(!$start){
191             # we found an end, without a beginning,
192             # therefore it was an error
193 0           return (\%values, $i, "No opening bracket found");
194             }
195 0           return (\%values, $i, "");
196             }
197             elsif($start){
198 0           $values{$line} = 0;
199             }
200             }
201 0           my %tmp = ();
202 0           return (\%tmp, $i, "No opening or closing bracket found");
203             }
204              
205             1;
206              
207             __END__