File Coverage

blib/lib/Catalyst/Model/SCP.pm
Criterion Covered Total %
statement 26 59 44.0
branch 0 8 0.0
condition n/a
subroutine 9 13 69.2
pod 2 2 100.0
total 37 82 45.1


line stmt bran cond sub pod time code
1             package Catalyst::Model::SCP;
2              
3 2     2   1050115 use 5.006;
  2         5  
4 2     2   8 use strict;
  2         2  
  2         34  
5 2     2   5 use warnings;
  2         6  
  2         40  
6              
7 2     2   501 use Moose;
  2         294623  
  2         12  
8 2     2   9596 use namespace::autoclean;
  2         5710  
  2         12  
9              
10             extends 'Catalyst::Model';
11              
12 2     2   514 use MooseX::Types::Moose qw/ Str Bool HashRef /;
  2         33636  
  2         18  
13 2     2   7880 use File::Temp qw/tempfile/;
  2         13282  
  2         194  
14 2     2   966 use Net::SCP::Expect;
  2         111049  
  2         61  
15 2     2   17 use Moose::Util::TypeConstraints;
  2         2  
  2         26  
16              
17             subtype 'IdentityFile'
18             => as 'Str'
19             => where { -f $_ }
20             => message { 'Invalid identity_file specified.' };
21              
22             =head1 NAME
23              
24             Catalyst::Model::SCP - SCP model class for Catalyst
25              
26             =head1 DESCRIPTION
27              
28             This module is really only a layer between Catalyst::Model and Net::SCP::Expect. Which help catalyst application to upload files using SCP.
29              
30             =head1 VERSION
31              
32             Version 0.01
33              
34             =cut
35              
36             our $VERSION = '0.01';
37              
38             =head1 SYNOPSIS
39              
40             package TestApp;
41              
42             use strict;
43             use warnings;
44              
45             use Catalyst;
46              
47             __PACKAGE__->config( 'Model::MYSCP' => {
48             host => '1.2.3.4',
49             user => 'user',
50             identity_file => '/home/user/.ssh/id_rsa',
51             net_scp_options => {
52             # Net::SCP::Expect options
53             }
54             }
55             );
56              
57             1;
58              
59             Create your model class
60              
61             package TestApp::Model::MYSCP;
62              
63             use 5.006;
64             use strict;
65             use warnings;
66              
67             use parent 'Catalyst::Model::SCP';
68              
69             1;
70              
71             In your catalyst application
72              
73             my $scp_client = $c->model('MYSCP');
74              
75             my $success = $scp_client->is_connection_success;
76             warn 'SCP connection is good.' if $success;
77              
78             my $success = $scp_client->put_file('local_file.txt','destination.txt');
79             warn 'File uploaded successfully' if $success;
80              
81             my $success = $scp_client->download_file('destination.txt','local_file.txt');
82             warn 'File downloaded successfully' if $success;
83              
84             =cut
85              
86             has host => (
87             isa => 'Str',
88             is => 'ro',
89             required => 1,
90             );
91              
92             has user => (
93             isa => 'Str',
94             is => 'ro',
95             required => 1,
96             );
97              
98             has identity_file => (
99             isa => 'IdentityFile',
100             is => 'ro',
101             required => 1,
102             );
103              
104             has net_scp_options => (
105             isa => 'HashRef',
106             is => 'ro',
107             default => sub {
108             return {};
109             }
110             );
111              
112             has net_scp => (
113             isa => 'Net::SCP::Expect',
114             is => 'ro',
115             lazy_build => 1,
116             );
117             sub _build_net_scp {
118 0     0     my $self = shift;
119 0           my $other_options = $self->net_scp_options;
120 0           my %default_options = (
121             'host' => $self->host,
122             'user' => $self->user,
123             'identity_file' => $self->identity_file,
124             'auto_yes' => 1
125             );
126 0           my %options = (%{$other_options}, %default_options);
  0            
127 0           return Net::SCP::Expect->new(%options);
128             }
129              
130             =head1 SUBROUTINES/METHODS
131              
132             =head2 is_connection_success
133              
134             C<is_connection_success()> - Returns true when it able to make connection using specified credentials.
135              
136             =cut
137              
138             has is_connection_success => (
139             isa => 'Bool',
140             is => 'ro',
141             lazy_build => 1
142             );
143             sub _build_is_connection_success {
144 0     0     my $self = shift;
145 0           my ($fh, $filename) = tempfile();
146 0           my $status = $self->put_file( $filename, '/home/'.$self->user.'/scp_connection_test' );
147 0           return $status;
148             }
149              
150             =head2 put_file
151              
152             C<put_file(LOCALFILE, REMOTEPATH)> - Transfer local file to the remote path.
153             Local file should have absolute path.
154             Remote file is the location on the remote server, no need to specify username, like normal scp.
155              
156             =cut
157              
158             sub put_file {
159 0     0 1   my( $self, $file, $destination ) = @_;
160 0 0         if ( not -f $file ){
161 0           warn "$file does not exist";
162 0           return 0;
163             }
164 0           my $scp_client = $self->net_scp;
165 0           my $status = 0;
166 0           eval {
167 0           $status = $scp_client->scp($file,$destination);
168             };
169 0 0         if ($@) {
170 0           warn $@;
171             }
172 0           return $status;
173             }
174              
175             =head2 download_file
176              
177             C<download_file(REMOTEFILE, LOCALPATH)> - Download remote file to local path.
178             Local file should have absolute path.
179             Remote file is the location on the remote server, no need to specify username, like normal scp.
180              
181             =cut
182              
183             sub download_file {
184 0     0 1   my( $self, $destination, $file ) = @_;
185 0 0         if ( not -e $file ){
186 0           warn "$file does not exist";
187 0           return 0;
188             }
189 0           my $scp_client = $self->net_scp;
190 0           my $status = 0;
191 0           eval {
192 0           my $destination_string = $self->user . '@' . $self->host .':'. $destination;
193 0           $status = $scp_client->scp($destination_string,$file);
194             };
195 0 0         if ($@) {
196 0           warn $@;
197             }
198 0           return $status;
199             }
200              
201             =head1 AUTHOR
202              
203             Rakesh Kumar Shardiwal, C<< <rakesh.shardiwal at gmail.com> >>
204              
205             =head1 BUGS
206              
207             Please report any bugs or feature requests to C<bug-catalyst-model-scp at rt.cpan.org>, or through
208             the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Catalyst-Model-SCP>. I will be notified, and then you'll
209             automatically be notified of progress on your bug as I make changes.
210              
211              
212              
213              
214             =head1 SUPPORT
215              
216             You can find documentation for this module with the perldoc command.
217              
218             perldoc Catalyst::Model::SCP
219              
220              
221             You can also look for information at:
222              
223             =over 4
224              
225             =item * RT: CPAN's request tracker (report bugs here)
226              
227             L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Catalyst-Model-SCP>
228              
229             =item * AnnoCPAN: Annotated CPAN documentation
230              
231             L<http://annocpan.org/dist/Catalyst-Model-SCP>
232              
233             =item * CPAN Ratings
234              
235             L<http://cpanratings.perl.org/d/Catalyst-Model-SCP>
236              
237             =item * Search CPAN
238              
239             L<http://search.cpan.org/dist/Catalyst-Model-SCP/>
240              
241             =back
242              
243              
244             =head1 ACKNOWLEDGEMENTS
245              
246              
247             =head1 LICENSE AND COPYRIGHT
248              
249             Copyright 2016 Rakesh Kumar Shardiwal.
250              
251             This program is free software; you can redistribute it and/or modify it
252             under the terms of the the Artistic License (2.0). You may obtain a
253             copy of the full license at:
254              
255             L<http://www.perlfoundation.org/artistic_license_2_0>
256              
257             Any use, modification, and distribution of the Standard or Modified
258             Versions is governed by this Artistic License. By using, modifying or
259             distributing the Package, you accept this license. Do not use, modify,
260             or distribute the Package, if you do not accept this license.
261              
262             If your Modified Version has been derived from a Modified Version made
263             by someone other than you, you are nevertheless required to ensure that
264             your Modified Version complies with the requirements of this license.
265              
266             This license does not grant you the right to use any trademark, service
267             mark, tradename, or logo of the Copyright Holder.
268              
269             This license includes the non-exclusive, worldwide, free-of-charge
270             patent license to make, have made, use, offer to sell, sell, import and
271             otherwise transfer the Package with respect to any patent claims
272             licensable by the Copyright Holder that are necessarily infringed by the
273             Package. If you institute patent litigation (including a cross-claim or
274             counterclaim) against any party alleging that the Package constitutes
275             direct or contributory patent infringement, then this Artistic License
276             to you shall terminate on the date that such litigation is filed.
277              
278             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
279             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
280             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
281             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
282             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
283             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
284             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
285             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
286              
287              
288             =cut
289              
290             1; # End of Catalyst::Model::SCP