File Coverage

blib/lib/File/MimeInfo/Simple.pm

Criterion	Covered	Total	%
statement	25	33	75.7
branch	4	12	33.3
condition	1	3	33.3
subroutine	6	7	85.7
pod	1	1	100.0
total	37	56	66.0

package File::MimeInfo::Simple;

use strict;
use warnings;

use Carp;
use YAML::Syck;
use File::Slurp;

require Exporter;

our $VERSION = '0.7';
our @ISA = qw(Exporter);
our @EXPORT = qw(mimetype);

my $lines = read_file(\*DATA);
my $yaml = Load($lines);

sub mimetype {
	my ($filename) = shift;

	croak "No filename passed to mimetype()" unless $filename;
	croak "Unable to read file: $filename" if -d $filename or ! -r $filename;

	my $mimetype = q{}; #until proven otherwise!
	# if platform -> windows
	if($^O =~ m!MSWin32!i) {
		return _find_mimetype_by_table($filename);
	} else {
    	$mimetype = `file --mime -br $filename`;
		unless($mimetype) {
			return _find_mimetype_by_table($filename);
		}
	}

	chomp $mimetype;

	$mimetype =~ s/[;,\s]+.*$//;
	return $mimetype;
}

sub _find_mimetype_by_table {
	my($filename) = shift;
	my $mimetype = q{};
	# getting extension. this is SIMPLE implementation, isn't it? :)
	my($ext) = $filename =~ /.+\.(.+?)$/;
	# my $ext = pop @{[split /\./, $filename]};
	return $mimetype unless $ext;
	return $yaml->{lc $ext} if(exists $yaml->{lc $ext});
	return $mimetype;
}

1;

=head1 NAME

File::MimeInfo::Simple - Simple implementation to determine file type

=head1 USAGE

 use File::MimeInfo::Simple;
 say mimetype("/Users/damog/vatos_rudos.jpg"); # prints out 'image/jpeg'
 say mimetype("C:\perl\foo.pl") # prints out 'application/x-perl'

=head1 DESCRIPTION

C is a much simpler implementation and uses a much
simpler approach than C, using the 'file' command on a
UNIX-based operating system. Windows uses a key-value list for extensions. It's
inspired on Matt Aimonetti's mimetype-fu used on Ruby and the Rails world.

=head1 FUNCTIONS

=head2 mimetype( $filename )

C is exported by default. It receives a parameter, the file
path. It returns an string containing the mime type for the file.

=head1 AUTHOR

David Moreno <[e-mail]>.

=head1 LICENSE

Copyright 2009 David Moreno.

This program is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.

=cut

__DATA__