File Coverage

blib/lib/CAD/Firemen/Common.pm
Criterion Covered Total %
statement 34 272 12.5
branch 1 114 0.8
condition 0 18 0.0
subroutine 12 32 37.5
pod 18 18 100.0
total 65 454 14.3


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2             ######################
3             #
4             # Copyright (C) 2011 - 2015 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: Shared functions used by other scripts from the Firemen module.
23              
24 1     1   5 use strict;
  1         2  
  1         29  
25 1     1   6 use warnings;
  1         1  
  1         51  
26              
27             package CAD::Firemen::Common;
28             {
29             $CAD::Firemen::Common::VERSION = '0.7.2';
30             }
31 1     1   5 use Exporter 'import';
  1         2  
  1         123  
32             our @EXPORT_OK = qw(
33             strip
34             print2ColsRightAligned
35             testPassed
36             testFailed
37             maxLength
38             printColored
39             printBlock
40             buildStatistic
41             getInstallationPath
42             getInstallationConfigCdb
43             getInstallationConfigPro
44             sharedDir
45             installationId
46             dbConnect
47             loadSettings
48             saveSettings
49             cleanSvn
50             );
51             our %EXPORT_TAGS = (
52             PRINTING => [qw(
53             print2ColsRightAligned
54             testPassed
55             testFailed
56             maxLength
57             printColored
58             printBlock
59             )]
60             );
61             BEGIN {
62 1 50   1   23 if($^O eq "MSWin32"){
63 0         0 require Win32::Console::ANSI;
64             }
65             }
66 1     1   5 use POSIX;
  1         1  
  1         8  
67 1     1   3805 use Term::ReadKey;
  1         4880  
  1         93  
68 1     1   1001 use Term::ANSIColor;
  1         8791  
  1         117  
69 1     1   11 use File::Path;
  1         2  
  1         51  
70 1     1   2572 use DBI;
  1         17765  
  1         70  
71 1     1   840 use YAML::XS qw(DumpFile LoadFile);
  1         2819  
  1         60  
72 1     1   6 use File::Path qw(rmtree);
  1         1  
  1         50  
73 1     1   747 use File::Find::Rule;
  1         7429  
  1         7  
74             # Auto reset colors after print line
75             #$Term::ANSIColor::AUTORESET = 1;
76              
77             sub strip {
78 0     0 1   my $string = shift;
79 0           chomp($string);
80 0           $string =~ s/^\s+//;
81 0           $string =~ s/\s+$//;
82 0           $string =~ s/\s{2,}/ /g;
83 0           return $string;
84             }
85              
86             sub untaint {
87 0     0 1   my $string = shift;
88 0 0         if(!defined($string)){
89 0           return "";
90             }
91 0 0         if($string =~ /^([\w\.\s\-\@\:\(\)\!\?\=\+\[\]\$\"\,\|\/\\;~]+)$/gs){
92 0           return $1;
93             }
94 0           return "";
95             }
96              
97             sub print2ColsRightAligned {
98 0     0 1   my $col1Text = untaint(shift);
99 0           my $col2Text = untaint(shift);
100 0           my $col2Color = untaint(shift);
101 0           my $terminalWidth = _terminalWidth();
102              
103 0 0         if(!defined($col2Color)){
104 0           $col2Color = "";
105             }
106              
107 0           my $len = $terminalWidth - length($col2Text) - 2;
108 0           print sprintf("%-". $len ."s", $col1Text);
109 0           printColored($col2Text, $col2Color);
110 0           print "\n";
111             }
112              
113             sub testPassed {
114 0     0 1   my $test = shift;
115 0           print2ColsRightAligned($test, "PASSED", "green");
116             }
117              
118             sub testFailed {
119 0     0 1   my $test = shift;
120 0           print2ColsRightAligned($test, "FAILED", "red");
121             }
122              
123             sub maxLength {
124 0     0 1   my @list = @_;
125              
126 0           my $max = 0;
127 0           foreach my $elem (@list){
128 0 0         if(length($elem) > $max){
129 0           $max = length($elem);
130             }
131             }
132 0           return $max;
133             }
134              
135             sub printColored {
136 0     0 1   my $text = untaint(shift);
137 0           my $color = untaint(shift);
138              
139 0 0         if(!defined($text)){
140 0           return;
141             }
142 0 0 0       if(!defined($color) or ($color eq "")){
143 0           $color = "RESET";
144             }
145              
146 0           print colored($text, $color);
147 0           print color 'reset';
148             }
149              
150             sub printBlock {
151 0     0 1   my $text = untaint(shift);
152 0           my $indent = untaint(shift);
153 0           my $color = untaint(shift);
154              
155 0 0         if(!defined($text)){
156 0           return;
157             }
158 0 0         if(!defined($indent)){
159 0           $indent = 0;
160             }
161 0 0 0       if(!defined($color) or ($color eq "")){
162 0           $color = "RESET";
163             }
164             # -2 is the linebreak
165 0           my $terminalWidth = _terminalWidth() - 2;
166 0           my $textWidth = $terminalWidth - $indent;
167              
168             # remove all linebreaks
169 0           $text =~ s/[\n\r]/ /gs;
170              
171 0           my $start = 0;
172 0           my $end = $textWidth;
173 0           while($start < length($text)){
174 0           my $line = strip(substr($text, $start, $end));
175 0           my $max = $terminalWidth;
176 0 0         if($textWidth > length($line)){
177 0           $max = length($line) + $indent;
178             }
179 0           printColored(sprintf("%". $max ."s", $line), $color);
180 0           print "\n";
181 0           $start += $end;
182             # $end is the number of returned characters
183 0 0         if($start + $end > length($text)){
184 0           $end = length($text) - $start;
185             }
186             }
187             }
188              
189             sub buildStatistic {
190 0     0 1   my $label = shift;
191 0           my $value = shift;
192 0           my $max = shift;
193 0           my $result = "";
194              
195 0 0         if(!defined($label)){
196 0           return $result;
197             }
198 0 0         if(!defined($value)){
199 0           return $result;
200             }
201 0 0 0       if(!defined($max) || ($max == 0)){
202 0           return $result;
203             }
204              
205 0           my $terminalWidth = _terminalWidth() - 2;
206 0           my $relValue = sprintf("%.0f", $value / $max * 100);
207 0           $label .= " [";
208             # - 6 is the percent itself (e.g.: " 69%, ")
209 0           my $valueLen = $terminalWidth - length($label) - 1 - 6 - length($value);
210 0 0         if($valueLen > 100){
211 0           $valueLen = 100;
212             }
213 0           my $signs = floor($valueLen * $relValue / 100);
214 0           my $space = $valueLen - $signs;
215 0           $result = "[";
216 0           for(my $i = 0; $i < $signs; $i++){
217 0           $result .= "=";
218             }
219 0           $result .= " ". sprintf("%". $space ."s %3s%%, %s", ("", $relValue, $value));
220 0           return $result;
221             }
222              
223             sub getInstallationPath {
224 0     0 1   my $result = "";
225 0           my @tempPaths = ($ENV{'PATH'} =~ m/;([^;]+(?:proe|creo)[^;]+);/gi);
226 0           my @paths = ();
227             # add the paths from config
228 0           my $config = loadSettings();
229 0 0         if(defined($config)){
230 0 0         if(exists($config->{"paths"})){
231 0           foreach my $dir (@{$config->{"paths"}}){
  0            
232 0           push(@paths, $dir);
233             }
234             }
235             }
236              
237             # add path from ENV{PATH}, if not already done
238 0           for(my $i = 0; $i < scalar(@tempPaths); $i++){
239 0 0         if($tempPaths[$i] =~ m/([\W\w]+)(?:\\|\/)mech(?:\\|\/)bin/i){
    0          
    0          
240 0           $tempPaths[$i] = $1;
241             }
242             elsif($tempPaths[$i] =~ m/([\W\w]+)(?:\\|\/)Parametric{0,1}(?:\\|\/)bin$/i){
243 0           $tempPaths[$i] = $1;
244              
245 0           my $alreadyInserted = 0;
246 0           foreach my $existing (@paths){
247 0 0         if(index($existing, $tempPaths[$i]) != -1){
248 0           $alreadyInserted = 1;
249 0           last;
250             }
251             }
252 0 0         if($alreadyInserted){
253 0           $tempPaths[$i] = "";
254             }
255             else{
256             # only search for common files, if path is not already added!
257 0           print "Searching for Common Files directory of installation ". $tempPaths[$i] ."\n";
258 0           my @commonFilesDirectories = File::Find::Rule->name("Common Files")->in($tempPaths[$i]);
259 0 0         if(scalar(@commonFilesDirectories) == 1){
260 0           testPassed(" Found Common Files for ". $tempPaths[$i]);
261 0           $tempPaths[$i] = $commonFilesDirectories[0];
262             }
263             else{
264 0           testFailed(" Found Common Files for ". $tempPaths[$i]);
265             }
266             }
267             }
268             elsif($tempPaths[$i] =~ m/([\W\w]+)(?:\\|\/)bin$/i){
269 0           $tempPaths[$i] = $1;
270             }
271 0 0         if($tempPaths[$i] ne ""){
272 0           my $add = 1;
273 0           foreach my $existing (@paths){
274 0 0         if($existing eq $tempPaths[$i]){
275 0           $add = 0;
276 0           last;
277             }
278             }
279 0 0         if($add){
280 0           push(@paths, $tempPaths[$i]);
281             }
282             }
283             }
284              
285 0 0         if(scalar(@paths) == 1){
286 0           $result = $paths[0];
287             }
288             else{
289 0           @paths = sort(@paths);
290             # determine default path
291 0           my $default = 0;
292 0 0         if(exists($config->{"defaultPath"})){
293 0           for(my $i = 0; $i < scalar(@paths); $i++){
294 0 0         if($config->{"defaultPath"} eq $paths[$i]){
295 0           $default = $i;
296 0           last;
297             }
298             }
299             }
300              
301 0           print "Possible installations:\n";
302 0           my $max = maxLength(@paths);
303 0           my $i = 0;
304 0           foreach my $dir (@paths){
305 0           print " ". sprintf("%-". $max ."s", $dir) ." ". $i ."\n";
306 0           $i++;
307             }
308 0           print "Or enter -1 to exit.\n";
309 0           print "Please choose one of the installations above [". $default ."]: ";
310 0           my $input = <>;
311 0           $input = strip($input);
312 0 0         if($input eq ""){
313 0           $input = $default;
314             }
315 0 0         if($input =~ /^\d+$/){
316 0 0 0       if(($input >= 0) && ($input < scalar(@paths))){
317 0           $result = $paths[$input];
318             }
319             else{
320 0           exit 0;
321             }
322             }
323             }
324              
325             # add all found paths to config
326 0           $config->{"paths"} = \@paths;
327 0           saveSettings($config);
328              
329 0           return $result;
330             }
331              
332             sub getInstallationConfigCdb {
333 0     0 1   my $installPath = shift;
334 0 0 0       if(!defined($installPath) || ($installPath eq "")){
335 0           $installPath = getInstallationPath();
336             }
337 0 0         if($installPath eq ""){
338 0           return "";
339             }
340 0           return $installPath ."/text/config.cdb";
341             }
342              
343             sub getInstallationConfigPro {
344 0     0 1   my $installPath = shift;
345 0 0 0       if(!defined($installPath) || ($installPath eq "")){
346 0           $installPath = getInstallationPath();
347             }
348 0 0         if($installPath eq ""){
349 0           return "";
350             }
351 0           return $installPath ."/text/config.pro";
352             }
353              
354             sub sharedDir {
355 0     0 1   my $dir = "c:/ProgramData/Firemen";
356 0 0         if(!-d $dir){
357 0 0         if(!mkpath($dir)){
358 0           return "";
359             }
360             }
361 0           return $dir;
362             }
363              
364             sub installationId {
365 0     0 1   my $path = shift;
366 0 0         if(!defined($path)){
367 0           return "";
368             }
369             # get most upper folder (root folder) of creo or proe
370 0 0         if($path =~ m/^.+((?:creo|proe)[^(?:\\|\/)]+).{0,}(M[0-9]{1,})/i){
371 0           $path = $1 ."-". $2;
372             }
373             else{
374 0           return "";
375             }
376 0           $path =~ s/\s/-/g;
377 0           return $path;
378             }
379              
380             sub dbConnect {
381 0     0 1   my $installation = shift;
382 0           my $verbose = shift;
383 0           my $dbh = undef;
384 0 0         if(!defined($verbose)){
385 0           $verbose = 0;
386             }
387 0 0         if(!defined($installation)){
388 0           return $dbh;
389             }
390              
391 0           $installation = installationId($installation);
392              
393 0 0         if($installation eq ""){
394 0           return $dbh;
395             }
396              
397 0           my $ref = loadSettings();
398 0           my $dbFile = "";
399 0           my %config = ();
400 0           my %dbs = ();
401 0 0         if(defined($ref)){
402 0           %config = %{$ref};
  0            
403 0 0         if(exists($config{"databases"})){
404 0           %dbs = %{$config{"databases"}};
  0            
405 0 0         if(exists($dbs{$installation})){
406 0           $dbFile = $dbs{$installation};
407             }
408             }
409             }
410 0 0         if($dbFile eq ""){
411 0           $dbFile = "/options-". $installation .".sqlite";
412 0           $dbs{$installation} = $dbFile;
413 0           $config{"databases"} = \%dbs;
414 0           saveSettings(\%config);
415             }
416              
417 0           $dbFile = sharedDir() . $dbFile;
418 0           my $printError = 0;
419 0 0         if($verbose > 1){
420 0           $printError = 1;
421             }
422             # we commit our self, to be much faster
423 0           $dbh = DBI->connect(
424             "dbi:SQLite:". $dbFile,
425             "",
426             "",
427             {PrintError => $printError, RaiseError => 0, AutoCommit => 0}
428             );
429 0 0         if(!$dbh){
430 0 0         if($verbose > 0){
431 0           print "Could not connect to database ". $dbFile ."\n";
432             }
433 0           return 0;
434             }
435 0           return $dbh;
436             }
437              
438             sub loadSettings {
439 0     0 1   my $file = _settingsFile();
440 0           my $result;
441 0 0         if(!-e $file){
442 0           return $result;
443             }
444 0           return LoadFile($file);
445             }
446              
447             sub saveSettings {
448 0     0 1   my $settingsRef = shift;
449 0 0         if(!defined($settingsRef)){
450 0           return 0;
451             }
452 0           return DumpFile(_settingsFile(), $settingsRef);
453             }
454              
455             sub cleanSvn {
456 0     0 1   my $dir = shift;
457 0           rmtree("$dir/.svn");
458 0           local *DIR;
459 0 0         opendir DIR, $dir or die "opendir $dir: $!";
460 0           for (readdir DIR) {
461 0 0         next if /^\.{1,2}$/;
462 0           my $path = "$dir/$_";
463 0 0         cleanSvn($path) if -d $path;
464             }
465 0           closedir DIR;
466             }
467              
468             sub _settingsFile {
469 0     0     return sharedDir() ."/config.yml";
470             }
471              
472             sub _terminalWidth {
473 0     0     my $terminalWidth = 100;
474 0           eval{
475 0           my @tmp = GetTerminalSize();
476 0 0         if(defined($tmp[0])){
477 0           $terminalWidth = $tmp[0];
478             }
479             };
480 0           return $terminalWidth;
481             }
482              
483             1;
484              
485             __END__