view release on metacpan or  search on metacpan

lib/Astro/App/Satpass2.pm  view on Meta::CPAN

#	* A code reference, which is returned unmodified
#
#	The code snippet will return undef at end-of-file.
#
#	The following keys in %opt are recognized:
#	{encoding} specifies the encoding of the file. How this is used
#	    on the $file argument as follows:
#	    * An open handle -- unused
#	    * A URL ----------- unused (encoding taken from HTTP::Response)
#	    * A file name ----- used (default is utf-8)
#	    * A scalar ref ---- used (default is un-encoded)
#	    * An array ref ---- unused
#	    * A code ref ------ unused
#	{glob} causes the contents of the file to be returned, rather
#	    than a reader.
#	{optional} causes the code to simply return on an error, rather
#	    than failing.

sub _file_reader {
    my ( $self, $file, $opt ) = @_;

    if ( openhandle( $file ) ) {
	$opt->{glob}
	    or return sub { return scalar <$file> };
	local $/ = undef;
	return scalar <$file>;
    }

    my $ref = ref $file;
    my $code = $self->can( "_file_reader_$ref" )
	or $self->wail( sprintf "Opening a $ref ref is unsupported" );

    goto &$code;
}

# Most of the following are called using '$self->can(
# "_file_reader_$ref" )', and there is no way a static analysis tool can
# find such calls. So we just have to exempt them from Perl::Critic

sub _file_reader_ {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( $self, $file, $opt ) = @_;
    $opt ||= {};

    defined $file
	and chomp $file;

    if ( ! defined $file || ! ref $file &&  '' eq $file ) {
	$opt->{optional} and return;
	$self->wail( 'Defined file required' );
    }

    if ( $self->_file_reader__validate_url( $file ) ) {
	my $ua = LWP::UserAgent->new();
	my $resp = $ua->get( $file );
	$resp->is_success()
	    or do {
	    $opt->{optional} and return;
	    $self->wail( "Failed to retrieve $file: ",
		$resp->status_line() );
	};
	$opt = { %{ $opt }, encoding => $resp->content_charset() };
	return $self->_file_reader(
	    \( scalar $resp->content() ),
	    $opt,
	);
    } else {
	my $encoding = $self->_file_reader__encoding( $opt );
	open my $fh, "<$encoding", $self->expand_tilde( $file )	## no critic (RequireBriefOpen)
	    or do {
	    $opt->{optional} and return;
	    $self->wail( "Failed to open $file: $!" );
	};
	$opt->{glob}
	    or return sub { return scalar <$fh> };
	local $/ = undef;
	return scalar <$fh>;
    }
}

sub _file_reader__encoding {
    my ( undef, $opt ) = @_;
    $opt ||= {};
    my $encoding = $opt->{encoding} || 'utf-8';
    $encoding = ":encoding($encoding)";
    OS_IS_WINDOWS
	and substr $encoding, 0, 0, ':crlf';
    return $encoding;
}


sub _file_reader__validate_url {
    my ( undef, $url ) = @_;		# Invocant unused

    load_package( 'LWP::UserAgent' )
	or return;

    load_package( 'URI' )
	or return;

    load_package( 'LWP::Protocol' )
	or return;

    my $obj = URI->new( $url )
	or return;
    $obj->can( 'authority' )
	or return 1;

    defined( my $scheme = $obj->scheme() )
	or return;
    LWP::Protocol::implementor( $scheme )
	or return;

    return 1;
}

sub _file_reader_ARRAY {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ( undef, $file, $opt ) = @_;	# Invocant unused

    my $inx = 0;
    $opt->{glob}
	or return sub { return $file->[$inx++] };