File Coverage

blib/lib/Goo/Profiler.pm
Criterion Covered Total %
statement 24 80 30.0
branch 0 14 0.0
condition n/a
subroutine 8 16 50.0
pod n/a
total 32 110 29.0


line stmt bran cond sub pod time code
1             package Profiler;
2              
3             ###############################################################################
4             # Nigel Hamilton
5             #
6             # Copyright Nigel Hamilton 2005
7             # All Rights Reserved
8             #
9             # Author: Nigel Hamilton
10             # Filename: Profiler.pm
11             # Description: Show a synopsis of a Thing
12             #
13             # Date Change
14             # -----------------------------------------------------------------------------
15             # 01/08/2005 Superclassed TemplateProfiler and ModuleProfiler
16             # 17/09/2005 Added method: makeIndex
17             # 22/09/2005 Added method: showProfiler
18             #
19             ###############################################################################
20              
21 1     1   7209 use strict;
  1         4  
  1         37  
22              
23 1     1   7 use Goo::Object;
  1         2  
  1         23  
24 1     1   6 use Goo::Prompter;
  1         3  
  1         24  
25 1     1   6 use Goo::ThingFinder;
  1         3  
  1         37  
26              
27 1     1   6 use Text::FormatTable;
  1         3  
  1         22  
28 1     1   530 use Goo::ThingProfileOption;
  1         3  
  1         27  
29              
30 1     1   6 use base qw(Goo::Object);
  1         2  
  1         629  
31              
32              
33             ###############################################################################
34             #
35             # show_header - show the top header
36             #
37             ###############################################################################
38              
39             sub show_header {
40              
41 0     0     my ($this, $thing) = @_;
42              
43 0           Goo::Prompter::show_header($thing);
44 0           Goo::Prompter::say($thing->{description});
45 0           Goo::Prompter::say();
46              
47             }
48              
49              
50             ###############################################################################
51             #
52             # run - goo interface method
53             #
54             ###############################################################################
55              
56             sub run {
57              
58 0     0     my ($this, $thing) = @_;
59              
60             ### get the commands for this Thing
61 0           my $command_string = join(', ', $thing->get_commands());
62              
63 0           while (1) {
64              
65             # show the profile
66 0           $this->show_profile($thing);
67              
68             # Prompter::notify("Got to here in profiler ... now what?");
69              
70 0           my $option_key = Goo::Prompter::pick_command($command_string);
71              
72             # if this is a lowercase option or a number
73             # this must be an option in the profile
74 0 0         if ($option_key =~ /[a-z0-9]/) {
    0          
75              
76             # Goo::Prompter::notify("looking up ---- $option_key");
77             # lookup the index
78 0           my $option = $this->get_option($option_key);
79 0 0         next unless $option;
80              
81             # Goo::Prompter::notify($option->to_string() . "\n");
82             # do the action
83 0           $option->do($thing);
84              
85             } elsif ($option_key =~ /[A-Z]/) {
86              
87             # it may be an uppercase command?
88 0 0         if ($thing->can_do_action($option_key)) {
89 0           $thing->do_action($option_key);
90             }
91              
92             } else {
93              
94 0           Goo::Prompter::notify("Invalid option. Press a key.");
95             }
96              
97             }
98              
99             }
100              
101              
102             ###############################################################################
103             #
104             # get_option - get the default action associated with the option
105             #
106             ###############################################################################
107              
108             sub get_option {
109              
110 0     0     my ($this, $option_key) = @_;
111              
112             # look up the option
113 0           return $this->{index}->{$option_key};
114              
115             }
116              
117              
118             ###############################################################################
119             #
120             # populate_table - give a table and a list fill it!
121             #
122             ###############################################################################
123              
124             sub populate_table {
125              
126 0     0     my ($this, $table, $number_of_columns, $option_type, @list) = @_;
127              
128 0           my @options = $this->get_option_list($option_type, @list);
129              
130             # sort the options alphabetically
131             # @options = sort { $a->get_text() cmp $b->get_text() } @options;
132              
133             # how many rows do we need?
134 0           my $number_of_rows = scalar(@options)/$number_of_columns;
135              
136             # is there a remainder?
137 0 0         if ($number_of_rows =~ /(\d+)\./) {
138 0           $number_of_rows = $1;
139 0           $number_of_rows++;
140             }
141              
142 0           foreach my $row (1 .. $number_of_rows) {
143              
144 0           my @args = ();
145              
146 0           foreach my $column (1 .. $number_of_columns) {
147              
148 0           my $option = shift(@options);
149              
150 0 0         if ($option) {
151 0           my $counter = shift(@{ $this->{counter} });
  0            
152 0           push(@args, "[$counter]");
153 0           $this->{index}->{$counter} = $option;
154 0           push(@args, $option->get_text());
155             } else {
156              
157             # blank cells
158 0           push(@args, '');
159 0           push(@args, '');
160              
161             }
162             }
163              
164 0           $table->row(@args);
165              
166             }
167              
168 0           return $table->render();
169              
170             }
171              
172              
173             ###############################################################################
174             #
175             # get_things_table - return a table of templates
176             #
177             ###############################################################################
178              
179             sub get_things_table {
180              
181 0     0     my ($this, $thing) = @_;
182              
183 1     1   8 use Goo::Prompter;
  1         2  
  1         324  
184              
185 0           Goo::Prompter::prompt("Looking for things in " . $thing);
186              
187 0           my @things = Goo::ThingFinder::get_things($thing);
188              
189 0           Goo::Prompter::prompt("Found " . scalar(@things));
190              
191 0 0         return unless @things;
192              
193 0           my $table = Text::FormatTable->new('4l 20l 4l 20l 4l 20l 4l 20l');
194              
195 0           $table->head('', 'Things', '', '', '', '', '', '');
196              
197 0           $table->rule('-');
198              
199 0           return $this->populate_table($table, 4, "Goo::ThingProfileOption", @things);
200              
201             }
202              
203              
204             ###############################################################################
205             #
206             # get_option_list - return a list of options
207             #
208             ###############################################################################
209              
210             sub get_option_list {
211              
212 0     0     my ($this, $option_type, @list) = @_;
213              
214 0           my @options = ();
215              
216 0           eval "require $option_type";
217              
218 0           foreach my $option_text (@list) {
219              
220 0           push(@options, $option_type->new({ text => $option_text }));
221              
222             }
223              
224 0           return @options;
225             }
226              
227              
228             ###############################################################################
229             #
230             # make_index - start off the index
231             #
232             ###############################################################################
233              
234             sub make_index {
235              
236 0     0     my ($this) = @_;
237              
238 0           $this->{counter} = [ 'a' .. 'z', 0 .. 9 ];
239              
240             }
241              
242              
243             ###############################################################################
244             #
245             # show_profile - this should be implemented by the subclass
246             #
247             ###############################################################################
248              
249             sub show_profile {
250              
251 0     0     print "showProfile not implemented\n";
252              
253              
254             }
255              
256             1;
257              
258              
259             __END__
260              
261             =head1 NAME
262              
263             Profiler - Show a synopsis of a Thing
264              
265             =head1 SYNOPSIS
266              
267             use Profiler;
268              
269             =head1 DESCRIPTION
270              
271              
272              
273             =head1 METHODS
274              
275             =over
276              
277             =item show_header
278              
279             show the top header
280              
281             =item run
282              
283             run this action handler
284              
285             =item get_option
286              
287             get the default action associated with the option
288              
289             =item populate_table
290              
291             give a table and a list fill it!
292              
293             =item get_things_table
294              
295             return a table of templates
296              
297             =item get_option_list
298              
299             return a list of options
300              
301             =item make_index
302              
303             start off the index
304              
305             =item show_profile
306              
307             this should be implemented by the subclass
308              
309             =back
310              
311             =head1 AUTHOR
312              
313             Nigel Hamilton <nigel@trexy.com>
314              
315             =head1 SEE ALSO
316