File Coverage

blib/lib/ZConf/Runner/GUI/GTK.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             package ZConf::Runner::GUI::GTK;
2              
3 1     1   22068 use warnings;
  1         3  
  1         37  
4 1     1   5 use strict;
  1         3  
  1         32  
5 1     1   403 use Gtk2;
  0            
  0            
6             use Gtk2::SimpleList;
7             use ZConf::Runner;
8             use File::MimeInfo::Magic;
9             use File::MimeInfo::Applications;
10              
11             =head1 NAME
12              
13             ZConf::Runner::GUI::GTK - The GTK GUI backend for ZConf::Runner.
14              
15             =head1 VERSION
16              
17             Version 0.0.2
18              
19             =cut
20              
21             our $VERSION = '0.0.2';
22              
23              
24             =head1 SYNOPSIS
25              
26             use ZConf::Runner::GUI::GTK;
27              
28             my $zcrgg = ZConf::Runner::GUI::GTK->new();
29             ...
30              
31             =head1 METHODS
32              
33             =head2 new
34              
35             This initializes it.
36              
37             One arguement is taken and that is a hash value.
38              
39             =head3 hash values
40              
41             =head4 zcrunner
42              
43             This is a ZConf::Runner object to use. If it is not specified,
44             a new one will be created.
45              
46             my $zcrgg = ZConf::Runner::GUI::GTK->new({zcrunner=>$zcrunner});
47             if($zcrgg->{error}){
48             print "Error!\n";
49             }
50              
51             =cut
52              
53             sub new{
54             my %args;
55             if(defined($_[1])){
56             %args= %{$_[1]};
57             }
58              
59             my $self={error=>undef, errorString=>undef};
60             bless $self;
61              
62             #initiates
63             if (defined($args{zcrunner})) {
64             $self->{zcr}=$args{zcrunner};
65             }else {
66             $self->{zcr}=ZConf::Runner->new();
67             }
68              
69             #get the ZConf object
70             $self->{zconf}=$self->{zcr}->{zconf};
71              
72             return $self;
73             }
74              
75             =head2 ask
76              
77             See ZConf::Runner::GUI for more information.
78              
79             =cut
80              
81             sub ask{
82             my $self=$_[0];
83             my %args;
84             if (defined($_[1])) {
85             %args= %{$_[1]};
86             }
87              
88             #blanks any previous errors
89             $self->errorblank;
90              
91             my $action=$args{action};
92             my $object=$args{object};
93              
94             #gets the mimetype for the object
95             my $mimetype=mimetype($object);
96              
97             #check if it is setup already
98             my $isSetup=$self->{zcr}->actionIsSetup($mimetype, $action);
99             my %action;
100             if ($isSetup) {
101             %action=$self->{zcr}->getAction($mimetype, $action);
102             if ($self->{zcr}->{error}) {
103             $self->{error}=3;
104             $self->{errorString}='ZConf::Runner errored. error="'.
105             $self->{zcr}->{error}.'" errorString="'.
106             $self->{zcr}->{errorString}.'"';
107             warn('ZConf-Runner-GUI-GTK ask:3: '.$self->{errorString});
108             return undef;
109             }
110             if (!defined($action{do})) {
111             $isSetup=0;
112             }
113             if (!defined($action{type})) {
114             $isSetup=0;
115             }else {
116             if (($action{type} ne 'desktop') && ($action{type} ne 'exec')) {
117             $isSetup=0;
118             }
119             }
120             }
121              
122             #get possible applications
123             my ($default, @others) = mime_applications_all($mimetype);
124             my @othersNames;
125             my $int=0;
126             while ( defined($others[$int]) ) {
127             $othersNames[$int]=$others[$int]->{file};
128             $othersNames[$int]=~s/.*\///;
129             $othersNames[$int]=~s/\.desktop$//;
130             $othersNames[$int]=~s/\n//;
131              
132             $int++;
133             }
134              
135             #this makes sure we got a mimetype
136             if (!defined($mimetype)) {
137             $self->{error}=1;
138             $self->{errorString}='Could not determime the mimetype for "'.$object.'"';
139             warn('ZConf-Runner-GUI-GTK ask:2: '.$self->{errorString});
140             return undef;
141             }
142              
143             my %gui;
144              
145             Gtk2->init;
146              
147             $gui{window}=Gtk2::Window->new();
148              
149             $gui{VH}=Gtk2::VBox->new;
150             $gui{VH}->show;
151              
152             #puts together the part that displays the object
153             $gui{objectHB}=Gtk2::HBox->new;
154             $gui{objectHB}->show;
155             $gui{objectInfo}=Gtk2::Entry->new;
156             $gui{objectInfo}->set_editable(0);
157             $gui{objectInfo}->set_text($object);
158             $gui{objectInfo}->show;
159             $gui{objectLabel}=Gtk2::Label->new('Object:');
160             $gui{objectLabel}->show;
161             $gui{objectHB}->pack_start($gui{objectLabel}, 0, 0, 0);
162             $gui{objectHB}->pack_start($gui{objectInfo}, 1, 1, 0);
163             $gui{VH}->pack_start($gui{objectHB}, 0, 0, 0);
164              
165             #the action stuff
166             $gui{actionHB}=Gtk2::HBox->new;
167             $gui{actionHB}->show;
168             $gui{actionInfo}=Gtk2::Entry->new;
169             $gui{actionInfo}->set_editable(0);
170             $gui{actionInfo}->set_text($action);
171             $gui{actionInfo}->show;
172             $gui{actionLabel}=Gtk2::Label->new('Action:');
173             $gui{actionLabel}->show;
174             $gui{actionHB}->pack_start($gui{actionLabel}, 0, 0, 0);
175             $gui{actionHB}->pack_start($gui{actionInfo}, 1, 1, 0);
176             $gui{VH}->pack_start($gui{actionHB}, 0, 0, 0);
177              
178             #the mime stuff stuff
179             $gui{mimeHB}=Gtk2::HBox->new;
180             $gui{mimeHB}->show;
181             $gui{mimeInfo}=Gtk2::Entry->new;
182             $gui{mimeInfo}->set_editable(0);
183             $gui{mimeInfo}->set_text($mimetype);
184             $gui{mimeInfo}->show;
185             $gui{mimeLabel}=Gtk2::Label->new('MIME type:');
186             $gui{mimeLabel}->show;
187             $gui{mimeHB}->pack_start($gui{mimeLabel}, 0, 0, 0);
188             $gui{mimeHB}->pack_start($gui{mimeInfo}, 1, 1, 0);
189             $gui{VH}->pack_start($gui{mimeHB}, 0, 0, 0);
190              
191             #add a seperator
192             $gui{hbar1}=Gtk2::HSeparator->new;
193             $gui{hbar1}->show;
194             $gui{VH}->pack_start($gui{hbar1}, 0, 0, 0);
195              
196             #entry stuff
197             $gui{desktopLabel}=Gtk2::Label->new('Desktop Entries');
198             $gui{desktopLabel}->show;
199             $gui{VH}->pack_start($gui{desktopLabel}, 0, 0, 0);
200             $gui{defaultHB}=Gtk2::HBox->new;
201             $gui{defaultHB}->show;
202             $gui{defaultInfo}=Gtk2::Entry->new;
203             if (defined($default)) {
204             $gui{defaultInfo}->set_text($default);
205             $gui{defaultInfo}->set_editable(0);
206             $gui{defaultInfo}->show;
207             $gui{defaultLabel}=Gtk2::Label->new('Default:');
208             $gui{defaultLabel}->show;
209             $gui{defaultHB}->pack_start($gui{defaultLabel}, 0, 0, 0);
210             $gui{defaultHB}->pack_start($gui{defaultInfo}, 1, 1, 0);
211             }else {
212             $gui{defaultLabel}=Gtk2::Label->new('Default: n/a');
213             $gui{defaultLabel}->show;
214             $gui{defaultHB}->pack_start($gui{defaultLabel}, 0, 0, 0);
215             }
216             $gui{VH}->pack_start($gui{defaultHB}, 0, 0, 0);
217             $gui{entriesSL}=Gtk2::SimpleList->new(
218             'Entries'=>'text',
219             );
220             $gui{entriesSL}->get_selection->set_mode('single');
221             $gui{entriesSL}->show;
222             push(@{$gui{entriesSL}->{data}}, @othersNames);
223             $int=0;
224             if (!defined($default)) {
225             $default='';
226             }
227             #if this is the current type, select the specified one if possible
228             #otherwise select the default
229             #failing the default, select the first
230             if ($isSetup && ($action{type} eq 'desktop')) {
231             while (defined($othersNames[$int])) {
232             if ($othersNames[$int] eq $action{do}) {
233             $gui{entriesSL}->select($int);
234             }
235            
236             $int++;
237             }
238             }else {
239             #select the default on in the list if possible
240             my $othersMatched=0;
241             while (defined($othersNames[$int])) {
242             if ($othersNames[$int] eq $default) {
243             $gui{entriesSL}->select($int);
244             $othersMatched=1;
245             }
246            
247             $int++;
248             }
249             #if not found, select the first one if possible
250             if (!$othersMatched && defined($othersNames[0])) {
251             $gui{entriesSL}->select(0);
252             }
253             }
254             $gui{VH}->pack_start($gui{entriesSL}, 1, 1, 0);
255              
256             #add a seperator
257             $gui{hbar2}=Gtk2::HSeparator->new;
258             $gui{hbar2}->show;
259             $gui{VH}->pack_start($gui{hbar2}, 0, 0, 0);
260              
261              
262             #execute stuff
263             $gui{executeLabel}=Gtk2::Label->new('Manual');
264             $gui{executeLabel}->show;
265             $gui{execHB}=Gtk2::HBox->new;
266             $gui{execHB}->show;
267             $gui{execLabel}=Gtk2::Label->new('exec:');
268             $gui{execLabel}->show;
269             $gui{execEntry}=Gtk2::Entry->new();
270             $gui{execEntry}->set_editable(1);
271             if ($isSetup && ($action{type} eq 'exec')) {
272             $gui{execEntry}->set_text($action{do});
273             }
274             $gui{execEntry}->show;
275             $gui{execLabel2}=Gtk2::Label->new('"%f" will be replaced by the filename when it is ran.');
276             $gui{execLabel2}->show;
277             $gui{VH}->pack_start($gui{executeLabel}, 0, 0, 0);
278             $gui{execHB}->pack_start($gui{execLabel}, 0, 0, 0);
279             $gui{execHB}->pack_start($gui{execEntry}, 1, 1, 0);
280             $gui{VH}->pack_start($gui{execHB}, 0, 0, 0);
281             $gui{VH}->pack_start($gui{execLabel2}, 0, 0, 0);
282              
283             #add a seperator
284             $gui{hbar3}=Gtk2::HSeparator->new;
285             $gui{hbar3}->show;
286             $gui{VH}->pack_start($gui{hbar3}, 0, 0, 0);
287            
288             #select which to use
289             $gui{selectLabel}=Gtk2::Label->new('Do you wish to use a desktop entry or a manualy specified program?');
290             $gui{selectLabel}->show;
291             $gui{VH}->pack_start($gui{selectLabel}, 0, 0, 0);
292             $gui{selectCB}=Gtk2::ComboBox->new_text();
293             $gui{selectCB}->append_text('Desktop Entry');
294             $gui{selectCB}->append_text('Manual');
295             #select which it should be set to
296             if ($isSetup) {
297             if ($action{type} eq 'desktop') {
298             $gui{selectCB}->set_active(0);
299             }else {
300             $gui{selectCB}->set_active(1);
301             }
302             }else {
303             $gui{selectCB}->set_active(0);
304             }
305             $gui{selectCB}->show;
306             $gui{VH}->pack_start($gui{selectCB}, 0, 0, 0);
307              
308             #add a seperator
309             $gui{hbar4}=Gtk2::HSeparator->new;
310             $gui{hbar4}->show;
311             $gui{VH}->pack_start($gui{hbar4}, 0, 0, 0);
312              
313             #this is what will be returned
314             my $toreturn=undef;
315              
316             #cancel and accept buttons
317             $gui{buttonHB}=Gtk2::HBox->new;
318             $gui{acceptLabel}=Gtk2::Label->new('Accept');
319             $gui{cancelLabel}=Gtk2::Label->new('Cancel');
320             $gui{accept}=Gtk2::Button->new();
321             $gui{accept}->add($gui{acceptLabel});
322             $gui{accept}->signal_connect(clicked=>sub{
323             #get the select type and convert it to the proper value
324             my $typeInt=$gui{selectCB}->get_active;
325             my $type;
326             if ($typeInt eq '0') {
327             $type='desktop';
328             }else {
329             $type='exec';
330             }
331              
332             #get what to do for a exec type
333             my $do;
334             if ($type eq 'exec') {
335             $do=$gui{execEntry}->get_text;
336             }
337             if ($type eq 'desktop') {
338             my @selectedA=$gui{entriesSL}->get_selected_indices;
339             my $selected=$selectedA[0];
340             $do=$othersNames[$selected];
341             }
342              
343             #update it
344             $self->{zcr}->newRunner({
345             mimetype=>$mimetype,
346             action=>$action,
347             type=>$type,
348             do=>$do,
349             });
350             if ($self->{zcr}->{error}) {
351             $self->{error}=2;
352             $self->{errorString}='Failed to update ZConf';
353             warn('ZConf-Runner-GUI-GTK ask:2: '.$self->{errorString});
354             return undef;
355             }
356              
357             $toreturn=1;
358              
359             Gtk2->main_quit;
360             });
361             $gui{cancel}=Gtk2::Button->new();
362             $gui{cancel}->add($gui{cancelLabel});
363             $gui{cancel}->signal_connect(clicked=>sub{
364             Gtk2->main_quit;
365             });
366             $gui{buttonHB}->pack_start($gui{accept}, 1, 1, 0);
367             $gui{buttonHB}->pack_start($gui{cancel}, 1, 1, 0);
368             $gui{VH}->pack_start($gui{buttonHB}, 0, 0, 0);
369              
370             #
371             $gui{window}->signal_connect('delete-event'=>sub{
372             Gtk2->main_quit;
373             });
374              
375             $gui{window}->add($gui{VH});
376              
377             $gui{window}->show_all;
378             Gtk2->main;
379              
380             return $toreturn;
381             }
382              
383             =head2 dialogs
384              
385             This returns the available dailogs.
386              
387             =cut
388              
389             sub dialogs{
390             return ('ask');
391             }
392              
393             =head2 windows
394              
395             This returns a list of available windows.
396              
397             =cut
398              
399             sub windows{
400             return undef;
401             }
402              
403             =head2 errorblank
404              
405             This blanks the error storage and is only meant for internal usage.
406              
407             It does the following.
408              
409             $self->{error}=undef;
410             $self->{errorString}="";
411              
412             =cut
413              
414             #blanks the error flags
415             sub errorblank{
416             my $self=$_[0];
417              
418             $self->{error}=undef;
419             $self->{errorString}="";
420              
421             return 1;
422             }
423              
424             =head1 ERROR CODEs
425              
426             =head2 1
427              
428             Could not get the mimetype.
429              
430             =head2 2
431              
432             Failed to update ZConf.
433              
434             =head2 3
435              
436             ZConf::Runner issued an error.
437              
438             =head1 AUTHOR
439              
440             Zane C. Bowers, C<< >>
441              
442             =head1 BUGS
443              
444             Please report any bugs or feature requests to C, or through
445             the web interface at L. I will be notified, and then you'll
446             automatically be notified of progress on your bug as I make changes.
447              
448              
449              
450              
451             =head1 SUPPORT
452              
453             You can find documentation for this module with the perldoc command.
454              
455             perldoc ZConf::Runner::GUI::GTK
456              
457              
458             You can also look for information at:
459              
460             =over 4
461              
462             =item * RT: CPAN's request tracker
463              
464             L
465              
466             =item * AnnoCPAN: Annotated CPAN documentation
467              
468             L
469              
470             =item * CPAN Ratings
471              
472             L
473              
474             =item * Search CPAN
475              
476             L
477              
478             =back
479              
480              
481             =head1 ACKNOWLEDGEMENTS
482              
483              
484             =head1 COPYRIGHT & LICENSE
485              
486             Copyright 2009 Zane C. Bowers, all rights reserved.
487              
488             This program is free software; you can redistribute it and/or modify it
489             under the same terms as Perl itself.
490              
491              
492             =cut
493              
494             1; # End of ZConf::Runner::GUI::GTK