]> git.donarmstrong.com Git - bin.git/blob - ss
add common subscriber
[bin.git] / ss
1 #! /usr/bin/perl
2 # ss makes a screenshot of the screen using import, and is released
3 # under the terms of the GPL version 2, or any later version, at your
4 # option. See the file README and COPYING for more information.
5 # Copyright 2004 by Don Armstrong <don@donarmstrong.com>.
6 # $Id$
7
8
9 use warnings;
10 use strict;
11
12
13 use Getopt::Long;
14 use Pod::Usage;
15
16 =head1 NAME
17
18 ss - Take a screenshot of the screen, scale it, and upload it to a server
19
20 =head1 SYNOPSIS
21
22 ss [options]
23
24  Options:
25   --host, -H host to upload image to
26   --dir, -D dir to place image (on host of -H set)
27   --import-options, -I options to import (default -window root)
28   --convert-options, -C options to convert (for scaling)
29   --scale, -s make scaled image (default)
30   --debug, -d debugging level (Default 0)
31   --help, -h display this help
32   --man, -m display manual
33
34 =head1 OPTIONS
35
36 =over
37
38 =item B<--host, -H>
39
40 The host where the image will be uploaded to using scp
41
42 =item B<--dir, -D>
43
44 The local (or remote if -H used) directory to place the resultant
45 screenshots
46
47 =item B<--import-options, -I>
48
49 The options used to invoke import. By default, -window root. (Which
50 will take a screenshot of the entire screen)
51
52 =item B<--convert-options, -C>
53
54 The options used to invoke convert, which will make a smaller image by
55 default. Only usefull if -s is set (which it is by default.)
56
57 =item B<--scale, -s>
58
59 If set (the default) a smaller image is made. (Technically, convert is
60 invoked with --convert-options, whether this scales depends on those
61 options.) To forgo scaling, use -s0 or --scale=0.
62
63 =item B<--debug, -d>
64
65 Debug verbosity. (Default 0)
66
67 =item B<--help, -h>
68
69 Display brief useage information.
70
71 =item B<--man, -m>
72
73 Display this manual.
74
75 =back
76
77 =head1 EXAMPLES
78
79   ss
80
81 Will pretty much do what you want
82
83   ss -I
84
85 Will take a picture of a window you select.
86
87 =cut
88
89
90
91 use User;
92 use File::Temp qw/tempfile tempdir/;
93
94 use vars qw($DEBUG);
95
96 # XXX parse config file
97
98 my %options = (debug           => 0,
99                help            => 0,
100                man             => 0,
101                host            => undef,
102                dir             => User->Home . '/ss',
103                import_options  => '-window root',
104                import          => 'import',
105                convert         => 'convert',
106                convert_options => '-scale 25%',
107                scale           => 1,
108                file_type       => 'png',
109                scp             => 'scp',
110               );
111
112 GetOptions(\%options,'host|H=s','import_options|I=s','file_type|t=s','scale|s!',
113            'convert_options|C=s','dir|D=s','debug|d+','help|h|?','man|m');
114
115 pod2usage() if $options{help};
116 pod2usage({verbose=>2}) if $options{man};
117
118 $DEBUG = $options{debug};
119
120
121 # XXX use perl's date command instead
122 my ($sec,$min,$hour,$mday,$mon,
123     $year,$wday,$yday,$isdst) = localtime(time);
124 $year += 1900;
125 my $date = qq($year).(${mon}+1).qq(${mday}_${hour}${min}${sec});
126
127 my $tempdir = undef;
128
129 # use tempdir if host defined
130 if (defined $options{host}) {
131      $tempdir = $options{tempdir} || tempdir( CLEANUP => 1 );
132      print "chdir $tempdir\n" if $options{debug};
133      chdir $tempdir or die "Unable to chidr to $tempdir";
134 }
135 else {
136      print "chdir $options{dir}\n" if $options{debug};
137      chdir $options{dir} or die "Unable to chdir to $options{dir}";
138 }
139
140 # import the image
141 print qq($options{import} $options{import_options} ss_${date}.$options{file_type}\n) if $options{debug};
142 qx($options{import} $options{import_options} ss_${date}.$options{file_type});
143
144 # scale the image
145
146 print qq($options{convert} $options{convert_options} ss_${date}.$options{file_type} ss_${date}_small.$options{file_type}\n) if $options{scale} and $options{debug};
147 qx($options{convert} $options{convert_options} ss_${date}.$options{file_type} ss_${date}_small.$options{file_type}) if $options{scale};
148
149 # upload
150 if (defined $options{host}) {
151      my $files = "ss_${date}.$options{file_type}";
152      $files .= " ss_${date}_small.$options{file_type}" if $options{scale};
153      print qq($options{scp} $files $options{host}:$options{dir}\n) if $options{debug};
154      qx($options{scp} $files $options{host}:$options{dir});
155 }
156
157
158 __END__