File Coverage

blib/lib/CGI/Application/Util/Diff/Actions.pm
Criterion Covered Total %
statement 9 73 12.3
branch 0 8 0.0
condition 0 4 0.0
subroutine 3 14 21.4
pod 0 9 0.0
total 12 108 11.1


line stmt bran cond sub pod time code
1             package CGI::Application::Util::Diff::Actions;
2              
3 1     1   4 use Carp;
  1         2  
  1         49  
4              
5 1     1   790 use Config::Tiny;
  1         902  
  1         28  
6              
7 1     1   786 use Hash::FieldHash qw/:all/;
  1         1908  
  1         1288  
8              
9             fieldhash my %config => 'config';
10              
11             our @ISA = qw(Exporter);
12              
13             # Items to export into callers namespace by default. Note: do not export
14             # names by default without a very good reason. Use EXPORT_OK instead.
15             # Do not simply export all your public functions/methods/constants.
16              
17             # This allows declaration use CGI::Application::Util::Diff::Actions ':all';
18             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
19             # will save memory.
20             our %EXPORT_TAGS = ( 'all' => [ qw(
21              
22             ) ] );
23              
24             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
25              
26             our @EXPORT = qw(
27              
28             );
29              
30             our $VERSION = '1.03';
31              
32             # -----------------------------------------------
33              
34             # Encapsulated class data.
35              
36             {
37             my(%_attr_data) =
38             (
39             _config_file => '',
40             );
41              
42             sub _default_for
43             {
44 0     0     my($self, $attr_name) = @_;
45              
46 0           $_attr_data{$attr_name};
47             }
48              
49             sub _standard_keys
50             {
51 0     0     keys %_attr_data;
52             }
53             }
54              
55             # -----------------------------------------------
56              
57             sub get_confirm_action
58             {
59 0     0 0   my($self) = @_;
60              
61 0   0       return ${$self -> config()}{'global'}{'confirm_action'} || 1;
62              
63             } # End of get_confirm_action.
64              
65             # -----------------------------------------------
66              
67             sub get_dir_actions
68             {
69 0     0 0   my($self) = @_;
70              
71 0           return ${$self -> config()}{'dir'};
  0            
72              
73             } # End of get_dir_actions.
74              
75             # -----------------------------------------------
76              
77             sub get_dir_commands
78             {
79 0     0 0   my($self) = @_;
80 0           my($dir_action) = $self -> get_dir_actions();
81              
82 0           my(%action);
83             my($command);
84 0           my($description);
85              
86 0           for my $action (sort keys %$dir_action)
87             {
88 0           ($command, $description) = split(/\s*=\s*/, $$dir_action{$action});
89 0           $action{$action} = $command;
90             }
91              
92 0           return {%action};
93              
94             } # End of get_dir_commands.
95              
96             # -----------------------------------------------
97              
98             sub get_dir_menu
99             {
100 0     0 0   my($self) = @_;
101 0           my($dir_action) = $self -> get_dir_actions();
102              
103 0           my(%action);
104             my($command);
105 0           my($description);
106              
107 0           for my $action (sort keys %$dir_action)
108             {
109 0           ($command, $description) = split(/\s*=\s*/, $$dir_action{$action});
110 0           $action{$action} = $description;
111             }
112              
113 0           return {%action};
114              
115             } # End of get_dir_menu.
116              
117             # -----------------------------------------------
118              
119             sub get_file_actions
120             {
121 0     0 0   my($self) = @_;
122              
123 0           return ${$self -> config()}{'file'};
  0            
124              
125             } # End of get_file_actions.
126              
127             # -----------------------------------------------
128              
129             sub get_file_commands
130             {
131 0     0 0   my($self) = @_;
132 0           my($file_action) = $self -> get_file_actions();
133              
134 0           my(%action);
135             my($command);
136 0           my($description);
137              
138 0           for my $action (sort keys %$file_action)
139             {
140 0           ($command, $description) = split(/\s*=\s*/, $$file_action{$action});
141 0           $action{$action} = $command;
142             }
143              
144 0           return {%action};
145              
146             } # End of get_file_commands.
147              
148             # -----------------------------------------------
149              
150             sub get_file_menu
151             {
152 0     0 0   my($self) = @_;
153 0           my($file_action) = $self -> get_file_actions();
154              
155 0           my(%action);
156             my($command);
157 0           my($description);
158              
159 0           for my $action (sort keys %$file_action)
160             {
161 0           ($command, $description) = split(/\s*=\s*/, $$file_action{$action});
162 0           $action{$action} = $description;
163             }
164              
165 0           return {%action};
166              
167             } # End of get_file_menu.
168              
169             # -----------------------------------------------
170             # We don't check for max_diff_line_count in sub new()
171             # because the user may not be using the file_diff action.
172              
173             sub get_max_diff_line_count
174             {
175 0     0 0   my($self) = @_;
176              
177 0   0       return ${$self -> config()}{'global'}{'max_diff_line_count'} || 100;
178              
179             } # End of get_max_diff_line_count.
180              
181             # -----------------------------------------------
182              
183             sub new
184             {
185 0     0 0   my($class, $arg) = @_;
186 0           my($self) = bless({}, $class);
187              
188 0           for my $attr_name ($self -> _standard_keys() )
189             {
190 0           my($arg_name) = $attr_name =~ /^_(.*)/;
191              
192 0 0         if (exists($$arg{$arg_name}) )
193             {
194 0           $$self{$attr_name} = $$arg{$arg_name};
195             }
196             else
197             {
198 0           $$self{$attr_name} = $self -> _default_for($attr_name);
199             }
200             }
201              
202             # Read the user-supplied or default config file.
203              
204 0           my($path) = $$self{'_config_file'};
205              
206 0 0         if (! $path)
207             {
208 0           my($name) = '.htutil.diff.actions.conf';
209              
210 0           for (keys %INC)
211             {
212 0 0         next if ($_ !~ m|CGI/Application/Util/Diff/Actions.pm|);
213              
214 0           ($path = $INC{$_}) =~ s/Actions.pm/$name/;
215             }
216             }
217              
218 0           $self -> config(Config::Tiny -> read($path) );
219              
220             # Check for sections [global], [dir] and [file].
221              
222 0           for my $section (qw/global dir file/)
223             {
224 0 0         if (! ${$self -> config()}{$section})
  0            
225             {
226 0           Carp::croak "Config file '$path' does not contain the section [$section]";
227             }
228             }
229              
230 0           return $self;
231              
232             } # End of new.
233              
234             # --------------------------------------------------
235              
236             1;