File Coverage

blib/lib/Autodia/Handler.pm
Criterion Covered Total %
statement 9 106 8.4
branch 0 40 0.0
condition 0 9 0.0
subroutine 3 12 25.0
pod 1 4 25.0
total 13 171 7.6


line stmt bran cond sub pod time code
1             ################################################################
2             # AutoDIA - Automatic Dia XML. (C)Copyright 2001 A Trevena #
3             # #
4             # AutoDIA comes with ABSOLUTELY NO WARRANTY; see COPYING file #
5             # This is free software, and you are welcome to redistribute #
6             # it under certain conditions; see COPYING file for details #
7             ################################################################
8             package Autodia::Handler;
9              
10 1     1   1241 use strict;
  1         3  
  1         72  
11              
12             require Exporter;
13 1     1   9 use vars qw($VERSION @ISA @EXPORT);
  1         3  
  1         78  
14              
15             @ISA = qw(Exporter);
16              
17 1     1   6 use Autodia::Diagram;
  1         2  
  1         1279  
18              
19             #---------------------------------------------------------------
20              
21             #####################
22             # Constructor Methods
23              
24             sub new
25             {
26 0     0 0   my $class = shift();
27 0           my $self = {};
28 0           my $config = shift;
29              
30 0   0       bless ($self, ref($class) || $class);
31 0           $self->_initialise($config);
32              
33 0           return $self;
34             }
35              
36             #------------------------------------------------------------------------
37             # Access Methods
38              
39             =head2 process
40              
41             parse file(s), takes hashref of configuration, returns no of files processed
42              
43             =cut
44              
45             sub process {
46 0     0 1   my $self = shift;
47 0           my %config = %{$self->{Config}};
  0            
48              
49 0           my $processed_files = 0;
50 0   0       my ($ignore_path) = grep { warn "$_" && $config{inputpath} eq $_.'/' } @{$config{directory}};
  0            
  0            
51 0           foreach my $filename (@{$config{filenames}}) {
  0            
52 0 0         my $current_file = ($ignore_path) ? $filename : $config{inputpath} . $filename ;
53 0           $current_file =~ s|\/+|/|g;
54 0 0         print "opening $current_file\n" unless ( $config{silent} );
55 0 0         $self->_reset() if ($config{singlefile});
56 0 0         $self->_parse_file($current_file)
57             or warn "no such file / database - $current_file \n";
58 0 0         $self->output($current_file) if ($config{singlefile});
59 0           $processed_files++;
60             }
61 0           return $processed_files;
62             }
63              
64             sub skip {
65 0     0 0   my ($self,$object_name) = @_;
66 0           my $skip = 0;
67 0           my $skip_list = $self->{Config}{skip_patterns};
68 0 0         if (ref $skip_list) {
69 0           foreach my $pattern (@$skip_list) {
70 0           chomp($pattern);
71 0 0         if ($object_name =~ m/$pattern/) {
72 0 0         warn "skipping $object_name : matches $pattern\n" unless ($self->{_config}{silent});
73 0           $skip = 1;
74 0           last;
75             }
76             }
77             }
78 0           return $skip;
79             }
80              
81              
82             sub output
83             {
84 0     0 0   my $self = shift;
85 0           my $alternative_filename = shift;
86 0           my $Diagram = $self->{Diagram};
87 0           my %config = %{$self->{Config}};
  0            
88              
89 0 0         if (defined $alternative_filename ) {
90 0           foreach my $dir (@{$config{'directory'}}) {
  0            
91 0           $alternative_filename =~ s|^$dir||g;
92             }
93 0           $alternative_filename =~ s|\/|-|g;
94 0           $alternative_filename =~ s|^-||;
95             }
96            
97              
98 0           $Diagram->remove_duplicates;
99              
100             # export output
101 0           my $success = 0;
102             OUTPUT_TYPE: {
103 0 0         if ($config{graphviz}) {
  0            
104 0 0         $self->{Config}{outputfile} = "$alternative_filename.png" if ($config{singlefile});
105 0           $success = $Diagram->export_graphviz(\%config);
106 0           last;
107             }
108              
109 0 0         if ($config{springgraph}) {
110 0 0         $self->{Config}{outputfile} = "$alternative_filename.png" if ($config{singlefile});
111 0           $success = $Diagram->export_springgraph(\%config);
112 0           last;
113             }
114              
115 0 0         if ($config{vcg}) {
116 0 0         $self->{Config}{outputfile} = "$alternative_filename.ps" if ($config{singlefile});
117 0           $success = $Diagram->export_vcg(\%config);
118 0           last;
119             }
120              
121             # default to XML output
122 0 0         $self->{Config}{outputfile} = "$alternative_filename.xml" if ($config{singlefile});
123 0           $success = $Diagram->export_xml(\%config);
124             } # end of OUTPUT_TYPE;
125 0 0         if ($success) {
126 0           warn "written outfile : $config{outputfile} successfully \n";
127             } else {
128 0           warn "nothing to output using $config{language} handler - are you sure you set the language correctly ?\n";
129             }
130 0           return 1;
131             }
132              
133             #-----------------------------------------------------------------------------
134             # Internal Methods
135              
136             sub _initialise
137             {
138 0     0     my $self = shift;
139 0           my $config_ref = shift;
140 0           my $Diagram = Autodia::Diagram->new($config_ref);
141              
142 0   0       $self->{Config} = $config_ref || ();
143 0           $self->{Diagram} = $Diagram;
144              
145 0           return 1;
146             }
147              
148             sub _reset {
149 0     0     my $self = shift;
150 0           my $config_ref = $self->{Config};
151 0           my $Diagram = Autodia::Diagram->new($config_ref);
152 0           $self->{Diagram} = $Diagram;
153 0           return 1;
154             }
155              
156             sub _error_file
157             {
158 0     0     my $self = shift;
159              
160 0           $self->{file_open_error} = 1;
161              
162 0           print "Handler.pm : _error_file : error opening file $! \n";
163             #$error_message\n";
164              
165 0           return 1;
166             }
167              
168             sub _parse
169             {
170 0     0     print "parsing file \n";
171 0           return;
172             }
173              
174             sub _parse_file {
175 0     0     my $self = shift();
176 0           my $filename = shift();
177 0           my %config = %{$self->{Config}};
  0            
178 0 0         my $infile = (defined $config{inputpath}) ?
179             $config{inputpath} . $filename : $filename ;
180              
181 0           $self->{file_open_error} = 0;
182              
183 0 0         open (INFILE, "<$infile") or $self->_error_file();
184              
185 0 0         if ($self->{file_open_error} == 1) {
186 0           warn " couldn't open file $infile \n";
187 0           print "skipping $infile..\n";
188 0           return 0;
189             }
190              
191 0           $self->_parse (\*INFILE,$filename);
192              
193 0           close INFILE;
194              
195 0           return 1;
196             }
197              
198             1;
199              
200             ###############################################################################
201              
202             =head1 NAME
203              
204             Handler.pm - generic language handler superclass
205              
206             =head1 CONSTRUCTION METHOD
207              
208             Not actually used but subclassed ie HandlerPerl or HandlerC as below:
209              
210             my $handler = HandlerPerl->New(\%Config);
211              
212             =cut