File Coverage

blib/lib/CGI/Application/Plugin/Stream.pm

Criterion	Covered	Total	%
statement	55	56	98.2
branch	14	20	70.0
condition	13	16	81.2
subroutine	7	7	100.0
pod	1	1	100.0
total	90	100	90.0

package CGI::Application::Plugin::Stream;

use 5.006;
use strict;
use warnings;

use CGI::Application 3.21;
use File::Basename;
require Exporter;
use vars (qw/@ISA @EXPORT_OK/);
@ISA = qw(Exporter);

@EXPORT_OK = qw(stream_file);

our $VERSION = '2.11';

sub stream_file {
    my ( $self, $file_or_fh, $bytes ) = @_;
    $bytes ||= 1024;
    my ($fh, $basename);
    my  $size = (stat( $file_or_fh ))[7];

    # If we have a file path
    if ( ref( \$file_or_fh ) eq 'SCALAR' ) {
        # They passed along a scalar, pointing to the path of the file
        # So we need to open the file
        open($fh,"<$file_or_fh"  ) || return 0;
        # Now let's go binmode (Thanks, William!)
        binmode $fh;
        $basename = basename( $file_or_fh );
    }
    # We have a file handle.
    else {
        $fh = $file_or_fh;
        $basename = 'FILE';
    }

    # Use FileHandle to make File::MMagic happy;
    # bless the filehandle into the FileHandle package to make File::MMagic happy
    require FileHandle;
    bless $fh,  "FileHandle";

    # Check what headers the user has already set and
    # don't override them.
    my %existing_headers = $self->header_props();

    # Check for a existing type header set with or without a hyphen
    unless ( $existing_headers{'-type'} ||  $existing_headers{'type'} ) {
        my $mime_type;

        eval {
            require File::MMagic;
            my $magic = File::MMagic->new();
            $mime_type = $magic->checktype_filehandle($fh);
        };
        warn "Failed to load File::MMagic module to determine mime type: $@" if $@;

        # Set Default
        $mime_type ||= 'application/octet-stream';

        $self->header_add('-type' => $mime_type);
    }


    unless ( $existing_headers{'Content_Length'}
        ||   $existing_headers{'-Content_Length'}
        ) {
        $self->header_add('-Content_Length' => $size);
    }

    unless ( $existing_headers{'-attachment'}
        ||   $existing_headers{'attachment'}
        ||   grep( /-?content-disposition/i, keys %existing_headers )
        ) {
        $self->header_add('-attachment' => $basename);
    }

    unless ( $ENV{'CGI_APP_RETURN_ONLY'} ) {
        $self->header_type( 'none' );
        print $self->query->header( $self->header_props() );
    }

    # This reads in the file in $byte size chunks
    # File::MMagic may have read some of the file, so seek back to the beginning
    my $output = "";
    seek($fh,0,0);
    while ( read( $fh, my $buffer, $bytes ) ) {
        if ( $ENV{'CGI_APP_RETURN_ONLY'} ) {
            $output .= $buffer;
        } else {
            print $buffer;
        }
    }

    print '' unless $ENV{'CGI_APP_RETURN_ONLY'}; # print a null string at the end
    close ( $fh );
    return $ENV{'CGI_APP_RETURN_ONLY'} ? \$output : 1;
}

1;
__END__