File Coverage

blib/lib/CAE/Nastran/Nasmod.pm

Criterion	Covered	Total	%
statement	130	142	91.5
branch	42	54	77.7
condition	10	12	83.3
subroutine	14	15	93.3
pod	8	11	72.7
total	204	234	87.1

package CAE::Nastran::Nasmod;

use strict;
use warnings;
use CAE::Nastran::Nasmod::Entity;
use vars qw($VERSION $ABSTRACT $DATE);

$VERSION           = '0.26';
$DATE              = 'Fri Apr 25 13:17:31 2014';
$ABSTRACT          = 'basic access to nastran models';

sub new
{
    my $this = shift;
    my $class = ref($this) || $this;
    my $self={};

    $self =
    {
		"bulk" => [],
		"tmp" => [],
    };

    bless ($self, $class);
    return $self;
}

#---------------------
# prints the whole model to STDOUT or a file
# print()
# return: 0 | 1
#---------------------
sub print
{
    my $self = shift;

	my $outfile = undef;
	if (@_)
	{
		$outfile = shift(@_);
		if (stat $outfile)
		{
			print("error: file does already exist. " . $outfile . "\n");
			return 0;
		}
	}

	# if an outfile has been defined, redirect STDOUT to this file
	if($outfile)
	{
		open (SAVE, ">&STDOUT") or die "can't save STDOUT $!\n";
		open (STDOUT, '>', $outfile) or die "can't redirect STDOUT to " . $outfile . ": $!";
	}

#	print "WOOOOOPP\n";
#	print "anzahl der entities: " . scalar(@{$self->{'bulk'}}) . "\n";

	# print each entity
	foreach my $entity (@{$self->{'bulk'}})
	{
		$entity->print();
	}

	# remove redirection of STDOUT
	if($outfile)
	{
		close STDOUT;
		open (STDOUT, ">&SAVE") or die "can't restore STDOUT $!\n";
		close SAVE;
	}

	return 1;
}
#---------------------

#---------------------
# imports data from a nastran file
# optional filtering possible
#---------------------
sub importBulk
{
	my $self = shift;
	my $path = shift;
	my $refh_options;

	if(@_)
	{
		$refh_options = shift;
	}

	if (!open (MODEL, "<$path")) {die "cannot read $path"}

	my @model = ;
	chomp @model;
	close MODEL;

	$self->{'tmp'} = \@model;

	if ($refh_options)
    {
    	$self->parse($refh_options);
    }
    else
    {
    	$self->parse();
    }
}

#---------------------
# parse bulkdata and store entity-objects in show
#---------------------
sub parse
{
    my $self = shift;

    my $maxoccur;
    my $occur = 0;

    my $cards;
    my $refa_filter;

    if (@_)
    {
	    my $refh_options = shift;
	    my %OPTIONS = %$refh_options;
	    if (defined $OPTIONS{'cards'})
	    {
	    	$cards = join("|", @{$OPTIONS{'cards'}});
	    }
	    if (defined $OPTIONS{'filter'})
	    {
	    	$refa_filter = $OPTIONS{'filter'};
	    }
	    if (defined $OPTIONS{'maxoccur'})
	    {
	    	$maxoccur = $OPTIONS{'maxoccur'};
	    }
    }

   	my $entity;
	my @comment;

	my $just_skipped = 0;

	my $folgezeile = 0;

    # each line of bulk
	foreach my $line (@{$self->{tmp}})
    {
    	# if its a comment
    	if ($line =~ m/^\$/)
    	{
    		push @comment, $line;
#	    	print "-----\n";
# 	    	print "COMMENT: $line\n";
    	}

    	# if its an entity
    	else
    	{

			# sofort ueberpruefen ob die karte ueberhaupt eingelesen werden soll
			if (($cards) && ($line =~ m/^\w+/) && ($line !~ m/^$cards/))
			{
				$just_skipped = 1;
				undef @comment;
				next;
			}

			# zeile zerteilen
    		my @line = &split8($line);

			# handelt es sich um die erste Zeile einer Karte?
    		if ($line =~ m/^\w+/)
			{
				$just_skipped = 0;
				$folgezeile = 0;

    			# first store previous entity-object if available and if matches the filter
    			if ($entity)
    			{
   					# greift der filter? dann ablegen | ist $maxoccur erreicht? dann abbrechen
   					if($entity->match($refa_filter))
   					{
#   						print "FILTER GREIFT fuer Zeile: $line\n";
   						$self->addEntity($entity);
   						$occur++;
	   					if( ($maxoccur) && ($maxoccur <= $occur) )
	   					{
	   						return;
	   					}
   					}
    			}

    			# ein neues entity anlegen
    			$entity = CAE::Nastran::Nasmod::Entity->new();
    			$entity->setComment(@comment);
    			undef(@comment);

    			# die zerhackte zeile durchgehen und in einem entity ablegen
    			for(my $x=0, my $col=1; $x<@line; $x++, $col++)
    			{
    				$entity->setCol($col, $line[$x]);
    			}
			}

			# wenn kein kommentar und keine schluesselzeile, dann handelt es sich um eine folgezeile.
			# diese soll nur dann beruecksichtigt werden, wenn die schluesselzeile nicht aussortiert wurde
			elsif (!($just_skipped))
			{
				$folgezeile++;

    			# die zerhackte zeile durchgehen und in einem entity ablegen
    			for(my $x=0, my $col=(1+($folgezeile * 10)); $x<@line; $x++, $col++)
    			{
    				$entity->setCol($col, $line[$x]);
    			}
			}
    	}
    }

	# zum schluss die letzte entity ablegen
    if ($entity)
    {
    	if ($entity->match($refa_filter))
    	{
    		$self->addEntity($entity);
    	}
    }

}
#---------------------

#---------------------
# split a string in chunks of 8 characters
#---------------------
sub split8
{
	my $string = shift;
	my @strings;
	for (my $x=0; ($x*8) < length($string); $x++)
	{
		my $substring = substr $string, ($x*8), 8;
		$substring =~ s/^\s+//;
		$substring =~ s/\s+$//;
		push @strings, $substring;
	}
	return @strings;
}
#---------------------

#---------------------
# adds an entity to show
# addEntity(@entities)
# return: -
#---------------------
sub addEntity
{
	my $self = shift;
	push @{$self->{bulk}}, @_;
}
#---------------------

#---------------------
# gets the entities that match the filter. if no filter is given, returns all entities
# getEntity(\@filter)
# return: @allEntitiesThatMatch
#---------------------
sub getEntity
{
	my $self = shift;

	# if a filter is given
	if(@_)
	{
		my $refh_filter = shift;
		my $newModel = $self->filter($refh_filter);
		return $newModel->getEntity();
	}

	# if no filter is given
	else
	{
		return @{$self->{bulk}};
	}

}
#---------------------

#---------------------
# filter model
# return a model
# filter array:
# $[0]: pattern for matching the comment
# $[1]: pattern for matching the row1 of entity
# $[2]: pattern for matching the row2 of entity
# an entity matches when every pattern of the given filter is found in entity at the given place.
#---------------------
sub filter
{
	my $self = shift;
	my $refa_filter = shift;
	my $refh_param;

	if (@_)
	{
		$refh_param = shift;
	}

	# ein neues objekt erzeugen
	my $filtered_model = CAE::Nastran::Nasmod->new();

# alle entities durchgehen
	foreach my $entity (@{$self->{'bulk'}})
	{
		if ($entity->match($refa_filter))
		{
			$filtered_model->addEntity($entity);
			if ($refh_param->{'firstonly'})
			{
				return $filtered_model;
			}
		}
	}
	return $filtered_model;
}
#---------------------

#---------------------
# getrow
sub getCol
{
	my $self = shift;
	my $row = shift;
	my @return;
	foreach my $entity (@{$self->{'bulk'}})
	{
		push @return, $entity->getrow($row);
	}
	return @return;
}
#---------------------

#---------------------
# merges models to this model
# merge(Nasmod, Nasmod, ...)
# return: -
#---------------------
sub merge
{
	my $self = shift;
	foreach my $model (@_)
	{
		push @{$self->{'bulk'}}, @{$model->{'bulk'}};
	}
}
#---------------------

#---------------------
# count_entities
# count()
# return: int
#---------------------
sub count
{
	my $self = shift;

	return scalar(@{$self->{'bulk'}});
}
#---------------------
1;

__END__