pshot

#!/usr/bin/perl
# vim: ft=perl:
# abstract: take screenshot, transfer it to host and return url
our $APP     = 'pshot';
our $VERSION = '0.21';

use strict;
use Getopt::Long;
use Pod::Usage;

my $base     = 'http://i.japh.se';
my $ssh_host = '192.168.1.128';
my $ssh_user = 'scp1';
my $ssh_port = 19216;

our($opt_bbcode,$opt_html);
GetOptions(
  bbcode  => \$opt_bbcode,
  html    => \$opt_html,
  '-h'    => sub { pod2usage(verbose => 1) && exit(0); },
  man     => sub { pod2usage(verbose => 3) && exit(0); },
);

my $dname = '';
if(@ARGV) {
  $dname .= "/" . shift(@ARGV);
}

print shot(),"\n";

sub shot {
  my $fname = 'pshot-' . time();
  system("scrot -q 100 $fname.png -t 7%") == 0 or die("scrot failed: $!");

  system(
    'ssh', '-p', $ssh_port,
    "$ssh_user\@$ssh_host", "mkdir -p http/japh.se/scrots/_full/$dname"
  ) == 0 or(die("ssh failed: $!"));

  # dupe STDOUT so we can reopen it when we wanna be loud
  open(OLD_STDOUT, '>&', STDOUT) or die("stddd$!");
  close(STDOUT);

  system(
    'scp', '-P', $ssh_port,
    "$fname.png",
    "$fname-thumb.png",
    "$ssh_user\@$ssh_host:http/japh.se/scrots/_full/$dname",
  ) == 0 or(die("scp failed: $!"));

  unlink("$fname.png") or print "$fname.png: $!" and exit(-1);
  unlink("$fname-thumb.png") or print "$fname-thumb.png: $!" and exit(-1);

  open(STDOUT, '>&', OLD_STDOUT) or die($!);

  if($opt_html) {
    return("<a href=\"$base/$fname.png\">");
  }
  elsif($opt_bbcode) {
    return(
      "[url=$base/$fname.png][img]$base/$fname-thumb.png\[/img][/url]"
    );
  }
  else {
    return("$base/$fname.png");
  }
  exit(0);
}

=pod

=head1 NAME

  pshot - screenshot automation tool

=head1 DESCRIPTION

  phshot takes a screenshot, transfers it to a remote host and return the
  resulting URI (assuming remote httpd). HTML style notation and BBCode syntax
  is optional.

=head1 OPTIONS

  -b,   --bbcode    return the uri in bbcode syntax
  -ht,  --html      return the uri wrapped in html href syntax
  -h,   --help      show the help and exit
  -m,   --man       show the manual and exit

=head1 AUTHOR

Written by Magnus Woldrich.

License: PerlArtistic

=head1 COPYRIGHT

Copyright (C) Magnus Woldrich 2010

=cut