File Coverage

blib/lib/App/Test/DWG/LibreDWG/JSON.pm
Criterion Covered Total %
statement 43 82 52.4
branch 1 20 5.0
condition 2 12 16.6
subroutine 12 14 85.7
pod 2 2 100.0
total 60 130 46.1


line stmt bran cond sub pod time code
1             package App::Test::DWG::LibreDWG::JSON;
2              
3 4     4   71247 use strict;
  4         24  
  4         107  
4 4     4   20 use warnings;
  4         7  
  4         105  
5              
6 4     4   2196 use Capture::Tiny qw(capture);
  4         119420  
  4         240  
7 4     4   1901 use File::Copy;
  4         9306  
  4         225  
8 4     4   28 use File::Path qw(mkpath);
  4         9  
  4         209  
9 4     4   1749 use File::Spec::Functions qw(catfile);
  4         3211  
  4         241  
10 4     4   27 use File::Temp qw(tempdir);
  4         8  
  4         146  
11 4     4   7761 use Getopt::Std;
  4         200  
  4         234  
12 4     4   1822 use IO::Barf qw(barf);
  4         41325  
  4         67  
13 4     4   235 use Readonly;
  4         10  
  4         2835  
14              
15             Readonly::Scalar our $DR => 'dwgread';
16             Readonly::Scalar our $DW => 'dwgwrite';
17              
18             our $VERSION = 0.01;
19              
20             # Constructor.
21             sub new {
22 2     2 1 1797 my ($class, @params) = @_;
23              
24             # Create object.
25 2         6 my $self = bless {}, $class;
26              
27             # Object.
28 2         19 return $self;
29             }
30              
31             # Run.
32             sub run {
33 1     1 1 7 my $self = shift;
34              
35             # Process arguments.
36 1         9 $self->{'_opts'} = {
37             'd' => undef,
38             'h' => 0,
39             'v' => 0,
40             };
41 1 50 33     38 if (! getopts('d:hv:', $self->{'_opts'}) || @ARGV < 1
      33        
42             || $self->{'_opts'}->{'h'}) {
43              
44 1         121 print STDERR "Usage: $0 [-d test_dir] [-h] [-v level] [--version] dwg_file\n";
45 1         14 print STDERR "\t-d test_dir\tTest directory (default is directory in system tmp).\n";
46 1         12 print STDERR "\t-h\t\tPrint help.\n";
47 1         13 print STDERR "\t-v level\tVerbosity level (default 0, max 9).\n";
48 1         11 print STDERR "\t--version\tPrint version.\n";
49 1         13 print STDERR "\tdwg_file\tAutoCAD DWG file to test.\n";
50 1         5 return 1;
51             }
52 0           $self->{'_dwg_file'} = shift @ARGV;
53              
54 0           my $tmp_dir = $self->{'_opts'}->{'d'};
55 0 0 0       if (defined $tmp_dir && ! -d $tmp_dir) {
56 0           mkpath($tmp_dir);
57             }
58 0 0 0       if (! defined $tmp_dir || ! -d $tmp_dir) {
59 0           $tmp_dir = tempdir(CLEANUP => 1);
60             }
61 0           $self->{'_tmp_dir'} = $tmp_dir;
62              
63             # Copy original file to dir.
64 0           my $dwg_file_first = catfile($tmp_dir, 'first.dwg');
65 0           copy($self->{'_dwg_file'}, $dwg_file_first);
66              
67             # Verbose level.
68 0           my $v = '-v'.$self->{'_opts'}->{'v'};
69              
70             # Convert dwg file to JSON.
71 0           my $json_file_first = catfile($tmp_dir, 'first.json');
72 0           my $dwg_to_json_first = "$DR $v -o $json_file_first $dwg_file_first";
73 0 0         if ($self->_exec($dwg_to_json_first, 'dwg_to_json')) {
74 0           return 1;
75             }
76              
77             # Convert JSON to dwg file.
78 0           my $dwg_file_second = catfile($tmp_dir, 'second.dwg');
79 0           my $json_to_dwg_first = "$DW $v -o $dwg_file_second $json_file_first";
80 0 0         if ($self->_exec($json_to_dwg_first, 'json_to_dwg')) {
81 0           return 1;
82             }
83              
84             # Convert new dwg file to JSON.
85 0           my $json_file_second = catfile($tmp_dir, 'second.json');
86 0           my $dwg_to_json_second = "$DR $v -o $json_file_second $dwg_file_second";
87 0 0         if ($self->_exec($dwg_to_json_second, 'dwg_to_json_second')) {
88 0           return 1;
89             }
90              
91             # Compare JSON files.
92 0           my $diff = "diff $json_file_first $json_file_second";
93 0           system($diff);
94              
95 0           return 0;
96             }
97              
98             sub _exec {
99 0     0     my ($self, $command, $log_prefix) = @_;
100              
101             my ($stdout, $stderr, $exit_code) = capture {
102 0     0     system($command);
103 0           };
104              
105 0 0         if (defined $log_prefix) {
106 0 0         if ($stdout) {
107 0           my $stdout_file = catfile($self->{'_tmp_dir'},
108             $log_prefix.'-stdout.log');
109 0           barf($stdout_file, $stdout);
110             }
111 0 0         if ($stderr) {
112 0           my $stderr_file = catfile($self->{'_tmp_dir'},
113             $log_prefix.'-stderr.log');
114 0           barf($stderr_file, $stderr);
115             }
116             }
117              
118 0 0         if ($exit_code) {
119 0           print STDERR "Command '$command' exit with $exit_code.\n";
120 0           return 1;
121             }
122              
123 0           return 0;
124             }
125              
126             1;
127              
128              
129             __END__