PageRenderTime 44ms CodeModel.GetById 10ms app.highlight 29ms RepoModel.GetById 1ms app.codeStats 0ms

/lib/Perlbal/UploadListener.pm

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