~tenbrae/mycat/trunk

« back to all changes in this revision

Viewing changes to lib/Mycat/scp.pm

  • Committer: devananda
  • Date: 2009-07-09 17:08:08 UTC
  • Revision ID: devananda.vdv@gmail.com-20090709170808-v2cb17v86p6oxzl7
initial import into bzr

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
package Mycat::scp;
 
2
 
 
3
use vars qw($VERSION $Timeout $Flush $PreserveDuringSCP $RecurseDuringSCP);
 
4
use strict;
 
5
 
 
6
$VERSION = '0.1';
 
7
$Timeout = 10;
 
8
$Flush = 1;
 
9
$PreserveDuringSCP = 1;
 
10
$RecurseDuringSCP  = 0;
 
11
 
 
12
use POSIX ":sys_wait_h";
 
13
use Mycat::TraceMessages qw(t tt ttt p pe);
 
14
 
 
15
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};   # Make %ENV safer
 
16
$ENV{'PATH'} = '/bin:/usr/bin';
 
17
 
 
18
=pod
 
19
 
 
20
=head1 NAME
 
21
 
 
22
Mycat::scp - Perl extension for MySQL Cluster Administration Tools
 
23
 
 
24
=head1 DESCRIPTION
 
25
 
 
26
Mycat is a collection of utilities for use in monitoring database clusters.
 
27
 
 
28
=head1 SYNOPSIS
 
29
 
 
30
# specify options to SCP
 
31
$Mycat::scp::PreserveDuringSCP = 1; // preserve file modification times
 
32
$Mycat::scp::RecurseDuringSCP  = 0; // do not recursively copy directories
 
33
 
 
34
# instantiate Mycat::scp objects
 
35
my $s = Mycat::scp::new('/path/to/local/file','[user@]host:/path/to/[file]');
 
36
 
 
37
# execute copy and retrieve result when finished
 
38
$Mycat::scp::Flush = 0;
 
39
my $result = $s->execute(); 
 
40
print $result;
 
41
 
 
42
# alternately, print results as they come back from remote server
 
43
$Mycat::scp::Flush = 1;
 
44
$s->execute();
 
45
 
 
46
=head1 USAGE
 
47
 
 
48
=over
 
49
 
 
50
=cut
 
51
 
 
52
# Mycat::scp::new {{{
 
53
=pod
 
54
 
 
55
=item Mycat::scp::new($origin,$destination)
 
56
 
 
57
 Initialize a new scp object.
 
58
 Both parameters are required.
 
59
 This function merely instantiates the object for further use.
 
60
 
 
61
    my $s = Mycat::scp::new('/path/to/local/file','[user@]host:/path/to/[file]');
 
62
 
 
63
=cut
 
64
sub new ($$)
 
65
{
 
66
        my $class = shift;
 
67
        my $self = {};
 
68
        $self->{origin} = shift or die("Mycat::scp::new called without origin");
 
69
        $self->{destin} = shift or die("Mycat::scp::new called without destination");
 
70
        $self->{result} = undef;
 
71
        bless ($self, $class);
 
72
        return $self;
 
73
} #}}}
 
74
 
 
75
# Mycat::scp::execute {{{
 
76
=pod
 
77
 
 
78
=item $s->execute()
 
79
 
 
80
 This is the workhorse of Mycat's SCP functions, spawning a child process to 
 
81
 encapsulate the SCP connection, passing the result back through shared memory.
 
82
 
 
83
 Timeout can be controlled via the variable ::Timeout, default is 10sec
 
84
 
 
85
 To see the internal workings of this function, turn trace debugging to level 3.
 
86
 
 
87
=cut
 
88
sub execute()
 
89
{
 
90
        my $self = shift;
 
91
        $self->{result} = '';
 
92
        my $itime = time;
 
93
 
 
94
    my $options;
 
95
    if ( $PreserveDuringSCP or $RecurseDuringSCP ) { 
 
96
        $options = '-';
 
97
        $options .= 'p' if $PreserveDuringSCP;
 
98
        $options .= 'r' if $RecurseDuringSCP;
 
99
    }
 
100
 
 
101
    tt('SCP: Copying ['.$self->{origin}.'] to ['.$self->{destin}.']...');
 
102
        
 
103
    my $childpid;
 
104
    
 
105
        if ( defined($options) ) {
 
106
        $childpid = open KID, '-|', 'scp', $options, $self->{origin}, $self->{destin};
 
107
    } else {
 
108
        $childpid = open KID, '-|', 'scp', $self->{origin}, $self->{destin};
 
109
    }
 
110
 
 
111
        ttt('SCP: forked and waiting for subprocess to finish');
 
112
 
 
113
        my $kid;
 
114
        my $itime = time;
 
115
 
 
116
        eval {
 
117
                local $SIG{ALRM} = sub { pe('Sending kill (9) signal to SCP after waiting '.$Timeout.' seconds'); kill 9, $childpid; };
 
118
                alarm $Timeout unless $Timeout == 0;
 
119
                while(<KID>) {
 
120
                        $self->{result} .= $_;
 
121
                        if ( $Flush ) {
 
122
                                chomp($_);
 
123
                                p($_);
 
124
                        }
 
125
                }
 
126
                alarm 0;
 
127
        };
 
128
        
 
129
        close KID || pe('SCP exited with abnormal status: '.$?);
 
130
        ttt('SCP: done');
 
131
        return $self->{result};
 
132
}
 
133
 
 
134
1;
 
135
 
 
136
=pod
 
137
 
 
138
=head1 AUTHOR
 
139
 
 
140
 Devananda van der Veen
 
141
 devananda.vdv@gmail.com
 
142
 
 
143
=cut
 
144
 
 
145
__END__