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__