Apache-Queue
1 match

 view release on metacpan or  search on metacpan

Queue.pm  view on Meta::CPAN 

        if(($#queue + 1) < $queue_size) {
          $pos = push @queue, "$now|$host";
          show_template("queue_position.html", { 'url' => $r->uri, 'position' => $pos, 'queue_size' => $#queue + 1 });
          $status = OK;
        } else {
          show_template("queue_full.html", { 'queue_size' => $queue_size });
          $status = OK;
        }
      }
    }
  }
    
  untie @sends;
  untie @queue;
  return $status;
}

sub send_file {
  my $r = shift;
  my $sub = $r->lookup_uri($r->uri);
  return $sub->run();
}

sub show_template {
  my ($name, $vars) = @_;

  my $file     = Template::Provider->new(ABSOLUTE  => '1');
  my $hash     = Queue::Template::Default->new();
  $template    = Template->new( {
    OUTPUT         => $r,
    LOAD_TEMPLATES => [ $file, $hash ],
    PREFIX_MAP     => {
      file    => '0',
      hash    => '1',
      default => '1',
    },
  });

  $r->content_type("text/html");

  my $path = $r->dir_config("TemplatePath");
  if($path ne '') {
    $template->process("file:$path/$name", $vars) || warn $template->error();
  } else {
    $template->process("hash:$name", $vars) || warn $template->error();
  }
}

package Queue::Template::Default;
@Queue::Template::Default::ISA = qw(Template::Provider);

my %Defaults = (
'queue_send.html' => <<EOQSH
<html>
<head>
<meta HTTP-EQUIV="refresh" content="1; URL=[% uri %]">
</head>
<body topmargin=0 leftmargin=0 marginheight=0 marginwidth=0>
<table height=100% width=100%>
<tr><td valign=center align=center>
<font face="arial" size=2>
Click <a href="[% uri %]">here</a> if your download does not start
</font>
</td></tr></table>
</body>
</html>
EOQSH
,
'queue_full.html' => <<EOQFH
<html>
<head>
<meta HTTP-EQUIV="refresh" content="300; URL=[% uri %]">
</head>
<body topmargin=0 leftmargin=0 marginheight=0 marginwidth=0>
<table height=100% width=100%>
<tr><td valign=center align=center>
<font face="arial" size=2>
Sorry, the queue is full<BR>Keep this window open to keep trying
</font>
</td></tr></table>
</body>
</html>
EOQFH
,
'queue_position.html' => <<EOQPH
<html>
<head>
<meta HTTP-EQUIV="refresh" content="60; URL=[% uri %]">
</head>
<body topmargin=0 leftmargin=0 marginheight=0 marginwidth=0>
<table height=100% width=100%>
<tr><td valign=center align=center>
<font face="arial" size=2>
You are in position [% position %] of [% queue_size %]<BR>
Keep this window open to stay in line
</font>
</td></tr></table>
</body>
</html>
EOQPH
,
'queue_sending.html' => <<EOQS
<html>
<body topmargin=0 leftmargin=0 marginheight=0 marginwidth=0>
<table height=100% width=100%>
<tr><td valign=center align=center>
<font face="arial" size=2>
You are already downloading a file
</font>
</td></tr></table>
</body>
</html>
EOQS
);

sub new {
  my $self = {};
  bless $self;
  return $self;
}

sub fetch {
  my ($self, $name) = @_;
  my ($data, $error);
  if($Defaults{$name} ne '') {
    $data = { text => $Defaults{$name} };
    ($data, $error) = $self->_compile($data);
    $data = $data->{ data } unless $error;
    return ($data, Template::Constants::STATUS_OK);
  } else{
    return (undef, Template::Constants::STATUS_ERROR);
  }
}

sub load {
  my ($self, $name) = @_;
  if($Defaults{$name} ne '') {
    return ($Defaults{$name}, Template::Constants::STATUS_OK);
  } else{
    return (undef, Template::Constants::STATUS_ERROR);
  }
}

1;
__END__

=head1 NAME

Apache::Queue - An HTTP file queueing system.

=head1 SYNOPSIS

  #httpd.conf
  <Directory "/usr/local/apache/htdocs/files">
    SetHandler perl-script
    PerlHandler Apache::Queue
    
    # the size of the queue (default: 300)
    PerlSetVar QueueSize 300
    
    # how many simultanious file transfers
    # before queueing (default: 10)
    PerlSetVar MaxSends 10
    
    # Location of queue files (default: /tmp)
    # This path must be writable by the Apache
    # process
    PerlSetVar QueuePath /tmp



( run in 0.870 second using v1.01-cache-2.11-cpan-5735350b133 )