##-*- Mode: CPerl -*-

## File: DTA::CAB::Server::HTTP::Handler::Directory.pm
## Author: Bryan Jurish <moocow@cpan.org>
## Description:
##  + CAB HTTP Server: request handler: directory
##======================================================================

package DTA::CAB::Server::HTTP::Handler::Directory;
use DTA::CAB::Server::HTTP::Handler;
use HTTP::Status;
use Carp;
use strict;

our @ISA = qw(DTA::CAB::Server::HTTP::Handler);

##--------------------------------------------------------------
## Aliases
BEGIN {
  DTA::CAB::Server::HTTP::Handler->registerAlias(
						 'DTA::CAB::Server::HTTP::Handler::directory'=>__PACKAGE__,
						 'DTA::CAB::Server::HTTP::Handler::dir'=>__PACKAGE__,
						 'DTA::CAB::Server::HTTP::Handler::Dir'=>__PACKAGE__,
						 'directory' => __PACKAGE__,
						 'dir' => __PACKAGE__,
						 'Dir' => __PACKAGE__,
						);
}

##--------------------------------------------------------------
## Methods

## $h = $class_or_obj->new(%options)
##  + options:
##     dir => $baseDirectory,  ##-- default='.'
##     logLevel => $level,     ##-- debug log level (defaul=undef (none))
sub new {
  my $that = shift;
  my $h =  bless { dir=>'.', @_ }, ref($that)||$that;
  $h->{dir} =~ s|/$||g;
  return $h;
}

## $bool = $h->prepare($server)
sub prepare { return (-d $_[0]{dir} && -r $_[0]{dir}); }

## $rsp = $h->run($server, $localPath, $clientConn, $httpRequest)
sub run {
  my ($h,$srv,$path,$csock,$hreq) = @_;
  my $path_matched = $path;
  my $path_full    = $hreq->uri->path();
  my $file         = $path_full;
  $file            =~ s/^\Q$path_matched\E\/?//;
  $file            = $h->{dir}.'/'.$file;
  $h->vlog($h->{logLevel}, "run(", $csock->peerhost, "): file=$file");
  return $h->error($csock,(-e $file ? RC_FORBIDDEN : RC_NOT_FOUND)) if (!-r $file);
  $csock->send_file_response($file);
  $csock->shutdown(2);
  $csock->close();
  return undef;
}

1; ##-- be happy

__END__

##========================================================================
## POD DOCUMENTATION, auto-generated by podextract.perl, edited

##========================================================================
## NAME
=pod

=head1 NAME

DTA::CAB::Server::HTTP::Handler::Directory - CAB HTTP Server: request handler: directory

=cut

##========================================================================
## SYNOPSIS
=pod

=head1 SYNOPSIS

 ##========================================================================
 ## PRELIMINARIES
 
 use DTA::CAB::Server::HTTP::Handler::Directory;
 
 ##========================================================================
 ## Methods
 
 $h = $class_or_obj->new(%options);
 $bool = $h->prepare($server);
 $rsp = $h->run($server, $localPath, $clientConn, $httpRequest);
 

=cut

##========================================================================
## DESCRIPTION
=pod

=head1 DESCRIPTION

DTA::CAB::Server::HTTP::Handler::Directory
is a L<DTA::CAB::Server::HTTP::Handler|DTA::CAB::Server::HTTP::Handler>
subclass for mirroring a local filesystem directory with a
L<DTA::CAB::Server::HTTP::Server|DTA::CAB::Server::HTTP::Server>.

=cut

##----------------------------------------------------------------
## DESCRIPTION: DTA::CAB::Server::HTTP::Handler::Directory: Methods
=pod

=head2 Methods

=over 4

=item new

 $h = $class_or_obj->new(%options);

%options, %$h:

 dir => $baseDirectory,  ##-- default='.'
 logLevel => $level,     ##-- debug log level (defaul=undef (none))

=item prepare

 $bool = $h->prepare($server);

Checks for readability of $h-E<gt>{dir}.

=item run

 $rsp = $h->run($server, $localPath, $clientConn, $httpRequest);

Retrieves and returns the file matching $localPath under $h-E<gt>{dir}.

=back

=cut

##========================================================================
## END POD DOCUMENTATION, auto-generated by podextract.perl
=pod



=cut

##======================================================================
## Footer
##======================================================================
=pod

=head1 AUTHOR

Bryan Jurish E<lt>moocow@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010-2019 by Bryan Jurish

This package is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.24.1 or,
at your option, any later version of Perl 5 you may have available.

=head1 SEE ALSO

L<DTA::CAB::Server::HTTP::Handler(3pm)|DTA::CAB::Server::HTTP::Handler>,
L<DTA::CAB::Server::HTTP(3pm)|DTA::CAB::Server::HTTP>,
L<DTA::CAB(3pm)|DTA::CAB>,
L<perl(1)|perl>,
...


=cut
