view release on metacpan or  search on metacpan

DwgRead.pm  view on Meta::CPAN

			my $tmp_glob_file = catfile($tmp_dir, $file_num);
			my @glob_files = glob $tmp_glob_file.'*';
			unlink @glob_files;
		}

		$file_num++;
	}

	return 0;
}

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

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

	if ($exit_code) {
		if (! $self->{'_opts'}->{'i'}) {
			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);

		# Report errors.
		if (! $self->{'_opts'}->{'i'}) {
			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)) {
				if ($self->{'_opts'}->{'f'}) {
					print $dwg_file.': ';
				}
				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__

=pod

=encoding utf8

=head1 NAME

App::Test::DWG::LibreDWG::DwgRead - Base class for test-dwg-libredwg-dwgread script.

=head1 SYNOPSIS

 use App::Test::DWG::LibreDWG::DwgRead;

 my $app = App::Test::DWG::LibreDWG::DwgRead->new;
 my $exit_code = $app->run;

=head1 METHODS

=head2 C<new>

 my $app = App::Test::DWG::LibreDWG::DwgRead->new;

Constructor.

Returns instance of object.

=head2 C<run>

 my $exit_code = $app->run;

Run.

Returns 1 for error, 0 for success.

=head1 EXAMPLE

=for comment filename=test_dwg_file.pl

 use strict;
 use warnings;

 use App::Test::DWG::LibreDWG::DwgRead;
 use File::Temp qw(tempdir);
 use File::Spec::Functions qw(catfile);
 use IO::Barf qw(barf);
 use MIME::Base64;

 # Bad DWG data in base64.