view release on metacpan or  search on metacpan

DwgRead.pm  view on Meta::CPAN

	my ($class, @params) = @_;

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

	# Object.
	return $self;
}

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

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

		print STDERR "Usage: $0 [-d test_dir] [-f] [-h] [-i] [-m match_string] [-s] [-v level] [--version] directory\n";
		print STDERR "\t-d test_dir\tTest directory (default is directory in system tmp).\n";
		print STDERR "\t-f\t\tPrint file.\n";
		print STDERR "\t-h\t\tPrint help.\n";
		print STDERR "\t-i\t\tIgnore errors.\n";
		print STDERR "\t-m match_string\tMatch string (default is not defined).\n";
		print STDERR "\t-s\t\tSelect files which are symlinks too.\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 @selected_files;
	if ($self->{'_opts'}->{'s'}) {
		@selected_files = File::Find::Rule->in($self->{'_directory'});
	} else {
		@selected_files = File::Find::Rule->dwg->not_symlink->in($self->{'_directory'});
	}
	my $file_num = 1;
	foreach my $dwg_file_in (@selected_files) {

		# 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);

		# tmp directory cleanup immediately.
		if (! defined $self->{'_opts'}->{'d'}) {
			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'}) {