/lib/Perlbal/UploadListener.pm

http://github.com/perlbal/Perlbal · Perl · 107 lines · 73 code · 20 blank · 14 comment · 5 complexity · 89728a0380e9dadc1d56725d7595aa0b MD5 · raw file

  1. ######################################################################
  2. # Listen for UDP upload status packets
  3. #
  4. # Copyright 2005-2007, Six Apart, Ltd.
  5. package Perlbal::UploadListener;
  6. use strict;
  7. use warnings;
  8. no warnings qw(deprecated);
  9. use base "Perlbal::Socket";
  10. use fields qw(service hostport);
  11. # TCPListener
  12. sub new {
  13. my ($class, $hostport, $service) = @_;
  14. my $sock =
  15. IO::Socket::INET->new(
  16. LocalAddr => $hostport,
  17. Proto => "udp",
  18. ReuseAddr => 1,
  19. Blocking => 0,
  20. );
  21. return Perlbal::error("Error creating listening socket: " . ($@ || $!))
  22. unless $sock;
  23. my $self = fields::new($class);
  24. $self->SUPER::new($sock);
  25. $self->{service} = $service;
  26. $self->{hostport} = $hostport;
  27. $self->watch_read(1);
  28. return $self;
  29. }
  30. my %status;
  31. my @todelete;
  32. sub get_status {
  33. my $ses = shift;
  34. return $status{$ses};
  35. }
  36. # TCPListener: accepts a new client connection
  37. sub event_read {
  38. my Perlbal::TCPListener $self = shift;
  39. my $buf;
  40. $self->{sock}->recv($buf, 500);
  41. return unless $buf =~ /^UPLOAD:(\w{5,50}):(\d+):(\d+):(\d+):(\d+)$/;
  42. my ($ses, $done, $total, $starttime, $nowtime) = ($1, $2, $3, $4, $5);
  43. my $now = time();
  44. $status{$ses} = {
  45. done => $done,
  46. total => $total,
  47. starttime => $starttime,
  48. lasttouch => $now,
  49. };
  50. # keep a history of touched records, then we'll clean 'em
  51. # after 30 seconds.
  52. push @todelete, [$now, $ses];
  53. my $too_old = $now - 4;
  54. while (@todelete && $todelete[0][0] < $too_old) {
  55. my $rec = shift @todelete;
  56. my $to_kill = $rec->[1];
  57. if (my $krec = $status{$to_kill}) {
  58. my $last_touch = $krec->{lasttouch};
  59. delete $status{$to_kill} if $last_touch < $too_old;
  60. }
  61. }
  62. }
  63. sub as_string {
  64. my Perlbal::TCPListener $self = shift;
  65. my $ret = $self->SUPER::as_string;
  66. my Perlbal::Service $svc = $self->{service};
  67. $ret .= ": listening on $self->{hostport} for service '$svc->{name}'";
  68. return $ret;
  69. }
  70. sub as_string_html {
  71. my Perlbal::TCPListener $self = shift;
  72. my $ret = $self->SUPER::as_string_html;
  73. my Perlbal::Service $svc = $self->{service};
  74. $ret .= ": listening on $self->{hostport} for service <b>$svc->{name}</b>";
  75. return $ret;
  76. }
  77. sub die_gracefully {
  78. # die off so we stop waiting for new connections
  79. my $self = shift;
  80. $self->close('graceful_death');
  81. }
  82. 1;
  83. # Local Variables:
  84. # mode: perl
  85. # c-basic-indent: 4
  86. # indent-tabs-mode: nil
  87. # End: