File Coverage

blib/lib/App/Nopaste/Service/ssh.pm
Criterion Covered Total %
statement 24 50 48.0
branch 0 16 0.0
condition 0 14 0.0
subroutine 8 9 88.8
pod 1 1 100.0
total 33 90 36.6


line stmt bran cond sub pod time code
1 1     1   592 use strict;
  1         2  
  1         23  
2 1     1   4 use warnings;
  1         2  
  1         46  
3             package App::Nopaste::Service::ssh;
4             # ABSTRACT: Copies files to your server using scp
5              
6             our $VERSION = '1.011';
7              
8 1     1   5 use parent 'App::Nopaste::Service';
  1         2  
  1         4  
9 1     1   508 use File::Temp;
  1         6299  
  1         61  
10 1     1   6 use File::Spec;
  1         2  
  1         19  
11 1     1   269 use POSIX qw(strftime);
  1         3443  
  1         8  
12 1     1   1150 use URI::Escape qw(uri_escape);
  1         3  
  1         52  
13 1     1   5 use namespace::clean 0.19;
  1         15  
  1         6  
14              
15             sub run {
16 0     0 1   my ($self, %args) = @_;
17              
18 0           my $source = $args{'filename'};
19              
20 0   0       my $server = $ENV{NOPASTE_SSH_SERVER} || return (0,"No NOPASTE_SSH_SERVER set");
21 0   0       my $docroot = $ENV{NOPASTE_SSH_DOCROOT} || return (0, "No NOPASTE_SSH_DOCROOT set");
22 0   0       my $topurl = $ENV{NOPASTE_SSH_WEBPATH} || "http://$server";
23 0   0       my $mode = $ENV{NOPASTE_SSH_MODE} || undef;
24             my $usedesc = defined $ENV{NOPASTE_SSH_USE_DESCRIPTION}
25             ? $ENV{NOPASTE_SSH_USE_DESCRIPTION}
26 0 0         : 1;
27              
28 0           my $date = strftime("%Y-%m-%d",localtime());
29 0 0 0       my ($ext) = defined $source && $source =~ s/(\.[^.\/\\]+?)$// ? $1 : '';
30              
31 0           my $suffix = $ext;
32 0 0         if ($usedesc) {
33 0 0         if (not $args{'desc'}) {
34 0           my $file = ( File::Spec->splitpath($source) )[2];
35 0   0       $args{'desc'} = $file || '';
36             }
37 0           $args{'desc'} =~ s/\s+/+/g; # more readable than %20
38 0 0         $suffix = ($args{'desc'} ? '-' : '') . $args{'desc'} . $suffix;
39             }
40              
41 0           my $tmp = File::Temp->new(
42             TEMPLATE => "${date}XXXXXXXX",
43             SUFFIX => $suffix,
44             UNLINK => 1,
45             TMPDIR => 1,
46             );
47 0           my $filename = File::Spec->rel2abs($tmp->filename);
48              
49             print $tmp $args{text}
50 0 0         or return (0, "Can't write to tempfile $filename");
51 0 0         close $tmp
52             or return (0, "Can't write to tempfile $filename");
53              
54 0 0         chmod oct($mode), $filename
55             if defined $mode;
56              
57 0           system('scp', '-pq', $filename, "$server:$docroot");
58              
59 0           my $file = ( File::Spec->splitpath($filename) )[2];
60 0           $file = uri_escape($file);
61 0           $file =~ s/%2b/+/gi;
62              
63 0           return (1, "$topurl/$file");
64             }
65              
66             1;
67              
68             __END__