| Text-Template-Simple documentation | Contained in the Text-Template-Simple distribution. |
Text::Template::Simple::Base::Examine - Base class for Text::Template::Simple
Private module.
This document describes version 0.83 of Text::Template::Simple::Base::Examine
released on 9 February 2011.
Private module.
Burak Gursoy <burak@cpan.org>.
Copyright 2004 - 2011 Burak Gursoy. All rights reserved.
This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.12.1 or, at your option, any later version of Perl 5 you may have available.
| Text-Template-Simple documentation | Contained in the Text-Template-Simple distribution. |
package Text::Template::Simple::Base::Examine; use strict; use warnings; use vars qw($VERSION); use Text::Template::Simple::Util qw(:all); use Text::Template::Simple::Constants qw(:all); $VERSION = '0.83'; sub _examine { my $self = shift; my $TMP = shift; my($type, $thing) = $self->_examine_type( $TMP ); my $rv; if ( $type eq 'ERROR' ) { $rv = $thing; $self->[TYPE] = $type; } elsif ( $type eq 'GLOB' ) { $rv = $self->_examine_glob( $thing ); $self->[TYPE] = $type; } else { if ( my $path = $self->io->file_exists( $thing ) ) { $rv = $self->io->slurp( $path ); $self->[TYPE] = 'FILE'; $self->[TYPE_FILE] = $path; } else { # just die if file is absent, but user forced the type as FILE $self->io->slurp( $thing ) if $type eq 'FILE'; $rv = $thing; $self->[TYPE] = 'STRING'; } } LOG( EXAMINE => sprintf q{%s; LENGTH: %s}, $self->[TYPE], length $rv ) if DEBUG; return $rv; } sub _examine_glob { my($self, $thing) = @_; my $type = ref $thing; fatal( 'tts.base.examine.notglob' => $type ) if $type ne 'GLOB'; fatal( 'tts.base.examine.notfh' ) if ! fileno $thing; return $self->io->slurp( $thing ); } sub _examine_type { my $self = shift; my $TMP = shift; my $ref = ref $TMP; return EMPTY_STRING , $TMP if ! $ref; return GLOB => $TMP if $ref eq 'GLOB'; if ( isaref( $TMP ) ) { my $ftype = shift @{ $TMP } || fatal('tts.base.examine._examine_type.ftype'); my $fthing = shift @{ $TMP } || fatal('tts.base.examine._examine_type.fthing'); fatal('tts.base.examine._examine_type.extra') if @{ $TMP }; return uc $ftype, $fthing; } return fatal('tts.base.examine._examine_type.unknown', $ref); } 1; __END__