File Coverage

blib/lib/App/Test/DWG/LibreDWG/DwgRead.pm

Criterion	Covered	Total	%
statement	50	93	53.7
branch	1	20	5.0
condition	2	12	16.6
subroutine	14	17	82.3
pod	2	2	100.0
total	69	144	47.9

package App::Test::DWG::LibreDWG::DwgRead;

use strict;
use warnings;

use Capture::Tiny qw(capture);
use File::Copy;
use File::Find::Rule;
use File::Find::Rule::DWG;
use File::Path qw(mkpath);
use File::Spec::Functions qw(catfile);
use File::Temp qw(tempdir);
use Getopt::Std;
use IO::Barf qw(barf);
use Readonly;

Readonly::Scalar our $DR => 'dwgread';

our $VERSION = 0.02;

# Constructor.
sub new {
	my ($class, @params) = @_;

	# Create object.
	my $self = bless {}, $class;

	# Object.
	return $self;
}

# Run.
sub run {
	my $self = shift;

	# Process arguments.
	$self->{'_opts'} = {
		'd' => undef,
		'h' => 0,
		'm' => undef,
		'v' => 1,
	};
	if (! getopts('d:hm:v:', $self->{'_opts'}) || @ARGV < 1
		|| $self->{'_opts'}->{'h'}) {

		print STDERR "Usage: $0 [-d test_dir] [-h] [-m match_string] [-v level] [--version] directory\n";
		print STDERR "\t-d test_dir\tTest directory (default is directory in system tmp).\n";
		print STDERR "\t-h\t\tPrint help.\n";
		print STDERR "\t-m match_string\tMatch string (default is not defined).\n";
		print STDERR "\t-v level\tVerbosity level (default 1, min 0, max 9).\n";
		print STDERR "\t--version\tPrint version.\n";
		print STDERR "\tdirectory\tDirectory with DWG files to test.\n";
		return 1;
	}
	$self->{'_directory'} = shift @ARGV;

	if ($self->{'_opts'}->{'v'} == 0) {
		warn "Verbosity level 0 hasn't detection of ERRORs.\n";
	}

	my $tmp_dir = $self->{'_opts'}->{'d'};
	if (defined $tmp_dir && ! -d $tmp_dir) {
		mkpath($tmp_dir);
	}
	if (! defined $tmp_dir || ! -d $tmp_dir) {
		$tmp_dir = tempdir(CLEANUP => 1);
	}
	$self->{'_tmp_dir'} = $tmp_dir;

	# Verbose level.
	my $v = '-v'.$self->{'_opts'}->{'v'};

	my $file_num = 1;
	foreach my $dwg_file_in (File::Find::Rule->dwg->in($self->{'_directory'})) {

		# Copy DWG file to dir.
		my $dwg_file_out = catfile($tmp_dir, $file_num.'.dwg');
		copy($dwg_file_in, $dwg_file_out);

		# dwgread.
		my $dwgread = "$DR $v $dwg_file_out";
		$self->_exec($dwgread, $file_num.'-dwgread', $dwg_file_in);

		$file_num++;
	}

	return 0;
}

sub _exec {
	my ($self, $command, $log_prefix, $dwg_file) = @_;

	my ($stdout, $stderr, $exit_code) = capture {
		system($command);
	};

	if ($exit_code) {
		print STDERR "Cannot dwgread '$dwg_file'.\n";
		print STDERR "\tCommand '$command' exit with $exit_code.\n";
		return;
	}

	if ($stdout) {
		my $stdout_file = catfile($self->{'_tmp_dir'},
			$log_prefix.'-stdout.log');
		barf($stdout_file, $stdout);
	}
	if ($stderr) {
		my $stderr_file = catfile($self->{'_tmp_dir'},
			$log_prefix.'-stderr.log');
		barf($stderr_file, $stderr);

		if (my @num = ($stderr =~ m/ERROR/gms)) {
			print STDERR "dwgread '$dwg_file' has ".scalar @num." ERRORs\n";
		}

		if (defined $self->{'_opts'}->{'m'}) {
			foreach my $match_line ($self->_match_lines($stderr)) {
				print $match_line."\n";
			}
		}
	}

	return;
}

sub _match_lines {
	my ($self, $string) = @_;

	my @ret;
	foreach my $line (split m/\n/ms, $string) {
		if ($line =~ /$self->{'_opts'}->{'m'}/) {
			push @ret, $line;
		}
	}

	return @ret;
}

1;


__END__