File Coverage

blib/lib/Metabrik/Xorg/Screenshot.pm
Criterion Covered Total %
statement 9 80 11.2
branch 0 30 0.0
condition 0 30 0.0
subroutine 3 10 30.0
pod 1 6 16.6
total 13 156 8.3


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # xorg::screenshot Brik
5             #
6             package Metabrik::Xorg::Screenshot;
7 1     1   542 use strict;
  1         3  
  1         30  
8 1     1   5 use warnings;
  1         2  
  1         29  
9              
10 1     1   6 use base qw(Metabrik::Shell::Command Metabrik::System::Package);
  1         1  
  1         458  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             datadir => [ qw(datadir) ],
20             output => [ qw(output) ],
21             format => [ qw(image_format) ],
22             delay => [ qw(microseconds) ],
23             },
24             attributes_default => {
25             output => 'screenshot-00001',
26             format => 'png',
27             delay => 100,
28             ignore_error => 0,
29             },
30             commands => {
31             install => [ ], # Inherited
32             active_window => [ qw(output|OPTIONAL format|OPTIONAL) ],
33             full_screen => [ qw(output|OPTIONAL format|OPTIONAL) ],
34             select_window => [ qw(output|OPTIONAL format|OPTIONAL) ],
35             window_id => [ qw(window_id output|OPTIONAL format|OPTIONAL) ],
36             continuous_by_window_id => [ qw(window_id delay|OPTIONAL) ],
37             },
38             require_modules => {
39             'Time::HiRes' => [ ],
40             'Metabrik::File::Find' => [ ],
41             'Metabrik::System::File' => [ ],
42             },
43             require_binaries => {
44             'import' => [ ],
45             'scrot' => [ ],
46             },
47             need_packages => {
48             ubuntu => [ qw(imagemagick scrot) ],
49             debian => [ qw(imagemagick scrot) ],
50             kali => [ qw(imagemagick scrot) ],
51             },
52             };
53             }
54              
55             sub _get_new_output {
56 0     0     my $self = shift;
57 0           my ($format) = @_;
58              
59 0   0       $format ||= $self->format;
60              
61 0           my $datadir = $self->datadir;
62              
63 0 0         my $ff = Metabrik::File::Find->new_from_brik_init($self) or return;
64 0 0         my $files = $ff->files($datadir, 'screenshot-\d+\.'.$format) or return;
65              
66 0 0         if (@$files == 0) {
67 0           return "$datadir/screenshot-00001.$format"; # First output file
68             }
69              
70 0           my @sorted = sort { $a cmp $b } @$files;
  0            
71 0           my ($id) = $sorted[-1] =~ m{screenshot-(\d+)\.$format};
72              
73 0           return $self->output(sprintf("$datadir/screenshot-%05d.$format", $id + 1));
74             }
75              
76             sub active_window {
77 0     0 0   my $self = shift;
78 0           my ($output, $format) = @_;
79              
80 0   0       $format ||= $self->format;
81 0   0       $output ||= $self->_get_new_output($format);
82              
83 0           $self->log->verbose("active_window: saving to file [$output]");
84              
85 0           my $cmd = "scrot --focused --border $output";
86 0 0         $self->execute($cmd) or return;
87              
88 0           return $output;
89             }
90              
91             sub full_screen {
92 0     0 0   my $self = shift;
93 0           my ($output, $format) = @_;
94              
95 0   0       $format ||= $self->format;
96 0   0       $output ||= $self->_get_new_output($format);
97              
98 0           $self->log->verbose("full_screen: saving to file [$output]");
99              
100 0           my $cmd = "scrot $output";
101 0 0         $self->execute($cmd) or return;
102              
103 0           return $output;
104             }
105              
106             sub select_window {
107 0     0 0   my $self = shift;
108 0           my ($output, $format) = @_;
109              
110 0   0       $format ||= $self->format;
111 0   0       $output ||= $self->_get_new_output($format);
112              
113 0           $self->log->verbose("select_window: saving to file [$output]");
114              
115 0           my $cmd = "scrot --select --border $output";
116 0 0         $self->execute($cmd) or return;
117              
118 0           return $output;
119             }
120              
121             sub window_id {
122 0     0 0   my $self = shift;
123 0           my ($window_id, $output, $format) = @_;
124              
125 0   0       $format ||= $self->format;
126 0   0       $output ||= $self->_get_new_output($format);
127 0 0         $self->brik_help_run_undef_arg('window_id', $window_id) or return;
128              
129 0 0         if ($format ne 'gif') {
130 0           return $self->log->error("window_id: only GIF format supported");
131             }
132              
133 0           my $cmd = "import -window $window_id $output";
134 0 0         my $r = $self->execute($cmd) or return;
135              
136 0 0         if ($r == 256) {
137 0           return $self->log->error("window_id: import failed");
138             }
139              
140 0           return $output;
141             }
142              
143             sub continuous_by_window_id {
144 0     0 0   my $self = shift;
145 0           my ($window_id, $delay) = @_;
146              
147 0   0       $delay ||= $self->delay;
148 0 0         $self->brik_help_run_undef_arg('continuous_by_window_id', $window_id) or return;
149              
150 0           my $datadir = $self->datadir;
151              
152 0 0         my $sf = Metabrik::System::File->new_from_brik_init($self) or return;
153 0 0         my $list = $sf->glob("$datadir/continuous-*gif") or return;
154 0 0         $sf->remove($list) or return;
155              
156 0           my @files = ();
157 0           my $file = '';
158 0           my $frame = 1;
159 0           while (1) {
160 0           $file = sprintf("$datadir/continuous-%05d.gif", $frame);
161 0           my $r = $self->execute("import -window $window_id $file");
162 0 0         if ($r > 1) { # It means we have been interrupted
163 0           $self->log->verbose("continuous_by_window_id: interrupted by user");
164 0           last;
165             }
166 0           $self->log->verbose("continuous_by_window_id: done with [$file]");
167 0           push @files, $file;
168 0           Time::HiRes::usleep($delay);
169 0           $frame++;
170             }
171              
172 0           return \@files;
173             }
174              
175             1;
176              
177             __END__