##-*- Mode: CPerl -*-

## File: DTA::CAB::Server::HTTP::Handler::File.pm
## Author: Bryan Jurish <moocow@cpan.org>
## Description:
##  + DTA::CAB::Server::HTTP::Handler class: static files
##======================================================================

package DTA::CAB::Server::HTTP::Handler::File;
use DTA::CAB::Server::HTTP::Handler;
use HTTP::Status;
use HTTP::Date qw();
use IO::File;
use Carp;
use strict;

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

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

##--------------------------------------------------------------
## $h = $class_or_obj->new(%options)
##  + options:
##     contentType => $mimeType,    ##-- default: text/plain ; alt. e.g. 'text/plain; charset="UTF-8"'
##     file => $filename,           ##-- filename to return
sub new {
  my $that = shift;
  return bless { file=>'', contentType=>undef, @_ }, ref($that)||$that;
}

## $bool = $obj->prepare($srv)
sub prepare { return (-r $_[0]{file}); }

## $rsp = $h->run($server, $localPath, $clientConn, $httpRequest)
sub run {
  my ($h,$srv,$path,$csock,$hreq) = @_;
  return $h->error($csock,(-e $h->{file} ? RC_FORBIDDEN : RC_NOT_FOUND)) if (!-r $h->{file});

  if (!$h->{contentType}) {
    $csock->send_file_response($h->{file});
    $csock->shutdown(2);
    $csock->close;
    return undef;
  }
  elsif (0) {
    ##-- weirdness
    my $CRLF = "\015\012"; ##-- "\r\n" is not portable
    my $rsp   = HTTP::Response->new(RC_OK, status_message(RC_OK));
    my ($size,$mtime) = (stat $h->{file})[7,9];
    $rsp->header('Content-Type' => $h->{contentType}) if ($h->{contentType});
    $rsp->header('Content-Length' => $size);
    $rsp->header('Last-Modified'  => HTTP::Date::time2str($mtime));
    $csock->send_basic_header;
    $csock->print($rsp->headers->as_string($CRLF), $CRLF);
    $csock->send_file($h->{file});
  }
  else {
    my $ioh = IO::File->new("<$h->{file}");
    return $h->error($csock,RC_NOT_FOUND) if (!defined($ioh));
    my $data = join('', $ioh->getlines);
    return HTTP::Response->new(RC_OK, status_message(RC_OK),
			       [
				'Content-Type' => $h->{contentType},
			       ],
			       $data);
  }
}


1; ##-- be happy

__END__

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

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

=head1 NAME

DTA::CAB::Server::HTTP::Handler::File - CAB HTTP Server: request handler: static file

=cut

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

=head1 SYNOPSIS

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

=cut

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

=head1 DESCRIPTION

=cut

##----------------------------------------------------------------
## DESCRIPTION: DTA::CAB::Server::HTTP::Handler::File: API
=pod

=over 4

=item new

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

%$h, %options:

 contentType => $mimeType,    ##-- default: text/plain
 file => $filename,           ##-- filename to return

=item prepare

 $bool = $obj->prepare($srv);

Checks for target file readability.

=item run

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

Returns the the contents of $h-E<gt>{file} to the client.

=back

=cut

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

##======================================================================
## 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
