home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _871bc3a3ca339a226b70c5958c0685e1 < prev    next >
Encoding:
Text File  |  2004-06-01  |  2.0 KB  |  91 lines
  1. package PPM::Installer::Remote;
  2. @PPM::Installer::Remote::ISA = qw(PPM::Installer);
  3.  
  4. use strict;
  5. use Data::Dumper;
  6. use PPM::PPD;
  7. use PPM::Result qw(Ok Warning Error List);
  8.  
  9. sub new {
  10.     my $class = shift;
  11.     my $targ = shift;
  12.     my $name = shift;
  13.     my $inst = bless {
  14.     name => $name,
  15.     host => $targ->{host},
  16.     type => $targ->{type},
  17.     port => $targ->{port},
  18.     }, $class;
  19.     return $inst;
  20. }
  21.  
  22. sub init {
  23.     my $inst = shift;
  24.     my $ok = $inst->connect_to($inst->{host}, $inst->{port});
  25.     die $ok->msg unless $ok->ok;
  26.     $ok;
  27. }
  28.  
  29. sub ckeys {
  30.     my $o = shift;
  31.     ($o->SUPER::ckeys,
  32.      qw(host),
  33.     );
  34. }
  35.  
  36. sub host {
  37.     my $o = shift;
  38.     $o->{host};
  39. }
  40.  
  41. sub pkginit {
  42.     my $o = shift;
  43.     my $package = shift;
  44.     $o->sendmsg($o->encode_record('PKGINIT', $package));
  45.     my @msg = $o->decode_record($o->recvmsg);
  46.     return Error($msg[1]) unless $msg[0] eq 'OK';
  47.     Ok();
  48. }
  49.  
  50. sub pkgfini {
  51.     my $o = shift;
  52.     my $package = shift;
  53.     $o->sendmsg($o->encode_record('PKGFINI', $package));
  54.     my @msg = $o->decode_record($o->recvmsg);
  55.     return Error($msg[1]) unless $msg[0] eq 'OK';
  56.     Ok();
  57. }
  58.  
  59. sub transmit {
  60.     my $o = shift;
  61.     my $package = shift;
  62.     my $file = shift;
  63.  
  64.     open (my $FILE, $file) or return Error("can't open $file: $!");
  65.     binmode($FILE);
  66.  
  67.     # Let the other side know we're coming:
  68.     $o->sendmsg($o->encode_record('TRANSMIT', $package, $file));
  69.     my @msg = $o->decode_record($o->recvmsg);
  70.     return Error($msg[1]) 
  71.       unless $msg[0] eq 'OK';
  72.  
  73.     # The size of individual packets is up to negotiation, but it makes some
  74.     # sense to pick a power of 2. I'm using 16384 bytes, or 16KB.
  75.     my $n;
  76.     my $dat;
  77.     while ($n = read($FILE, $dat, 16384)) {
  78.     $dat = $o->encode_record('DATA', $dat);
  79.     $o->sendmsg($dat);
  80.     }
  81.  
  82.     # Tell them we're done:
  83.     $o->sendmsg('EOT');
  84.     
  85.     @msg = $o->decode_record($o->recvmsg);
  86.     return Error($msg[1]) unless $msg[0] eq 'OK';
  87.     Ok();
  88. }
  89.  
  90. 1;
  91.