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

#!/usr/bin/perl
######################
#
#    Copyright (C) 2011  TU Clausthal, Institut fuer Maschinenwesen, Joachim Langenbach
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see .
#
######################

# Pod::Weaver infos
# ABSTRACT: Module to parse files from Firemen (like pro and cdb files)

use strict;
use warnings;

package CAD::Firemen::Load;
{
  $CAD::Firemen::Load::VERSION = '0.7.1';
}
use Exporter 'import';
our @EXPORT_OK = qw(loadConfig loadCDB loadDatabase);
use POSIX;
use CAD::Firemen::Common qw(strip printColored);


sub loadConfig {
  my $cfgUrl = shift;
  my $CFG;
  my %options= ();
  my %errors = ();

  if(!defined($cfgUrl) || $cfgUrl eq ""){
    $errors{0} = "No URL given";
    return (\%options, \%errors, 0);
  }

  # Get all possible options listed within the cdb file
  if(!open($CFG, "<", $cfgUrl)){
    $errors{0} = "Could not open file! (". $cfgUrl .")";
    return (\%options, \%errors, 0);
  }

  my $i = 0;
  while(<$CFG>){
    my $line = strip($_);
    $i++;
    # skip comments and mapkeys
    if($line !~ m/^\s*!/){
      if($line =~ m/^\s*mapkey/){
        # handle mapkeys here
      }
      else{
        if($line =~ m/^([^\s]+)\s+([^!]+)/){
          my $opt = uc($1);
          if(!exists($options{$opt})){
            $options{$opt} = {};
          }
          $options{$opt}->{strip($i)} = strip($2);
        }
        else{
          if($line ne ""){
            $errors{$i} = "Detected uncommented line without an option";
          }
        }
      }
    }
  }

  close($CFG);

  return (\%options, \%errors, $i);
}

sub loadCDB {
  my $cdbUrl = shift;
  my $CDB;
  my %results = ();
  my %errors = ();

  if(!defined($cdbUrl) || $cdbUrl eq ""){
    $errors{0} = "No URL given";
    return (\%results, \%errors);
  }

  # Get all possible options listed within the cdb file
  if(!open($CDB, "<", $cdbUrl)){
    $errors{0} = "Could not open file! (". $cdbUrl .")";
    return (\%results, \%errors);
  }

  my $i = 1;
  while(<$CDB>){
    my $line = strip($_);
    if($line =~ m/^([^\s]+)\s{0,}\( -[\w\d]+\s{0,}\)/){
      my $ref;
      my $error = "";
      my $lineNumber = $i;
      ($ref, $i, $error) = _extractParameters($CDB, $i);
      $results{uc($1)} = { $lineNumber => $ref };
      if($error ne ""){
        $errors{$i} = $error;
      }
      # this can not be treated as an error, because many options does not have values supplied
      #if(scalar(@opts) < 1){
      #  $errors{$i} = "WARNING: Could not get a list of parameters for option ". $1;
      #}
    }
    $i++;
  }

  close($CDB);

  return (\%results, \%errors);
}

sub loadDatabase {
  my $dbh = shift;
  my $sqlQuery = shift;
  my $verbose = shift;

  my %options = ();
  my %errors = ();
  my %descriptions = ();

  if(!defined($verbose)){
    $verbose = 0;
  }
  if(!$dbh){
    $errors{0} = "No database handle given";
    return (\%options, \%errors, \%descriptions);
  }
  if(!defined($sqlQuery) || ($sqlQuery eq "")){
    $errors{0} = "No SQL Query string given";
    return (\%options, \%errors, \%descriptions);
  }
  my $ref = $dbh->selectall_hashref($sqlQuery, 'name');
  if(!$ref){
    $errors{0} = "Error ". $dbh->err ." (". $dbh->errstr .")";
    return (\%options, \%errors, \%descriptions);
  }
  my %results = %{$ref};
  foreach my $name (keys(%results)){
    $sqlQuery  = "SELECT vals.id as id, vals.name as name FROM options_values as vals, options_has_values opthasvals";
    $sqlQuery .= " WHERE vals.id=opthasvals.valuesId";
    $sqlQuery .= "  AND opthasvals.optionsId=". $results{$name}->{"id"};
    $ref = $dbh->selectall_hashref($sqlQuery, "id");
    if(!defined($ref)){
      next;
    }
    my %tmpValues = ();
    foreach my $valId (keys(%{$ref})){
      $tmpValues{$ref->{$valId}->{"name"}} = 0;
      if(defined($results{$name}->{"defaultValueId"}) && ($valId == $results{$name}->{"defaultValueId"})){
        $tmpValues{$ref->{$valId}->{"name"}} = 1;
      }
    }
    # we use line 0 here, because we do not know the line
    $options{$name} = { 0 => \%tmpValues};
    $descriptions{$name} = $results{$name}->{"description"};
  }

  return (\%options, \%errors, \%descriptions);
}

sub _extractParameters {
  my $CDB = shift;
  # the line number
  my $i = shift;
  my $start = 0;
  my %values = ();
  while(<$CDB>){
    # raise it here, because we have read a new line already
    $i++;
    my $line = strip($_);
    if($line eq "{"){
      $start = 1;
    }
    elsif($line eq "}"){
      if(!$start){
        # we found an end, without a beginning,
        # therefore it was an error
        return (\%values, $i, "No opening bracket found");
      }
      return (\%values, $i, "");
    }
    elsif($start){
      $values{$line} = 0;
    }
  }
  my %tmp = ();
  return (\%tmp, $i, "No opening or closing bracket found");
}

1;

__END__