r66670 - in /branches/upstream/libfile-type-webimages-perl: ./ current/ current/lib/ current/lib/File/ current/lib/File/Type/ current/t/ current/t/files/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Thu Dec 30 23:53:26 UTC 2010
Author: jawnsy-guest
Date: Thu Dec 30 23:53:17 2010
New Revision: 66670
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=66670
Log:
[svn-inject] Installing original source of libfile-type-webimages-perl (1.01)
Added:
branches/upstream/libfile-type-webimages-perl/
branches/upstream/libfile-type-webimages-perl/current/
branches/upstream/libfile-type-webimages-perl/current/Build.PL (with props)
branches/upstream/libfile-type-webimages-perl/current/Changes
branches/upstream/libfile-type-webimages-perl/current/MANIFEST
branches/upstream/libfile-type-webimages-perl/current/META.yml
branches/upstream/libfile-type-webimages-perl/current/Makefile.PL
branches/upstream/libfile-type-webimages-perl/current/README
branches/upstream/libfile-type-webimages-perl/current/lib/
branches/upstream/libfile-type-webimages-perl/current/lib/File/
branches/upstream/libfile-type-webimages-perl/current/lib/File/Type/
branches/upstream/libfile-type-webimages-perl/current/lib/File/Type/WebImages.pm
branches/upstream/libfile-type-webimages-perl/current/t/
branches/upstream/libfile-type-webimages-perl/current/t/01type.t
branches/upstream/libfile-type-webimages-perl/current/t/02mime.t
branches/upstream/libfile-type-webimages-perl/current/t/files/
branches/upstream/libfile-type-webimages-perl/current/t/files/blank.bmp (with props)
branches/upstream/libfile-type-webimages-perl/current/t/files/blank.gif (with props)
branches/upstream/libfile-type-webimages-perl/current/t/files/blank.jpg (with props)
branches/upstream/libfile-type-webimages-perl/current/t/files/blank.png (with props)
Added: branches/upstream/libfile-type-webimages-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/Build.PL?rev=66670&op=file
==============================================================================
--- branches/upstream/libfile-type-webimages-perl/current/Build.PL (added)
+++ branches/upstream/libfile-type-webimages-perl/current/Build.PL Thu Dec 30 23:53:17 2010
@@ -1,0 +1,14 @@
+#!/usr/bin/perl
+use Module::Build;
+
+use strict;
+
+Module::Build->new(
+ module_name => 'File::Type::WebImages',
+ license => 'perl',
+ requires => {
+ 'Test::More' => 0.01,
+ 'IO::File' => 0.01,
+ },
+ create_makefile_pl => 'traditional',
+)->create_build_script;
Propchange: branches/upstream/libfile-type-webimages-perl/current/Build.PL
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libfile-type-webimages-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/Changes?rev=66670&op=file
==============================================================================
--- branches/upstream/libfile-type-webimages-perl/current/Changes (added)
+++ branches/upstream/libfile-type-webimages-perl/current/Changes Thu Dec 30 23:53:17 2010
@@ -1,0 +1,74 @@
+Changelog for File::Type::WebImages
+
+1.01 Sat Jan 3 06:52:23 EST 2009
+ - explicitly return undef for an undef() input to mime_type, preventing warnings.
+
+1.00 Mon Apr 23 15:49:07 EDT 2007
+ - no code changes
+ - added TODO block
+
+0.49_1 Sat Mar 3 00:08:48 EST 2007
+ Lots of incompatible changes
+ - Added support for BMP files
+ - Changed interface from OO to functional
+ - Dropped support for image/x-jpeg-proprietary
+ - Changed return value for unknowns from "application/octet-stream" to undef
+ - Simplified published interface by only exposing "mime_type".
+
+0.30 Wed Feb 28 10:07:18 EST 2007
+ (not released publicly)
+ - Forked into File::Type::WebImages
+
+0.22 Thu May 06 11:00:00 BST 2004
+
+ - Added MIME type for PDFs
+ - Added some MP3 detection
+
+0.21 Mon Apr 26 14:10:00 BST 2004
+
+ - Differentiated .wav and .avi
+
+0.20 Wed Mar 03 16:10:00 GMT 2004
+
+ - Added .asf movie support, and accompanying tests
+ - Added NINJA file
+
+0.12 Fri Dec 05 16:40:00 GMT 2003
+
+ - Fixed more minor documentation glitches
+ - Removed File::Slurp dependency
+
+0.11 Wed Sep 24 10:40:00 BST 2003
+
+ - Fixed minor documentation glitches
+
+0.10 Mon Sep 01 11:45:00 BST 2003
+
+ - added mime_type method to take either file or data
+ - removed superflous Build file from manifest, distribution
+ - tidied test suite
+
+0.05 Tue Aug 26 17:18:00 BST 2003
+
+ - fixed documentation bugs
+ - added belong to generation and rules
+
+0.04 Tue Aug 26 13:02:00 BST 2003
+
+ - first public release
+ - fixed substr/undef warnings on small files
+
+0.03 Tue Aug 26 11:14:00 BST 2003
+
+ - added and documented clearcode.org mime-magic
+ - smaller test images
+
+0.02 Fri Aug 22 15:00:00 BST 2003
+
+ - corrected Builder.pm to handle tar and gzip types
+ - many additional tests
+
+0.01 Thu Aug 21 17:30:00 BST 2003
+
+ - initial version
+ - works for image/jpeg
Added: branches/upstream/libfile-type-webimages-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/MANIFEST?rev=66670&op=file
==============================================================================
--- branches/upstream/libfile-type-webimages-perl/current/MANIFEST (added)
+++ branches/upstream/libfile-type-webimages-perl/current/MANIFEST Thu Dec 30 23:53:17 2010
@@ -1,0 +1,13 @@
+Build.PL
+Changes
+MANIFEST This list of files
+META.yml
+Makefile.PL
+README
+lib/File/Type/WebImages.pm
+t/01type.t
+t/02mime.t
+t/files/blank.gif
+t/files/blank.jpg
+t/files/blank.png
+t/files/blank.bmp
Added: branches/upstream/libfile-type-webimages-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/META.yml?rev=66670&op=file
==============================================================================
--- branches/upstream/libfile-type-webimages-perl/current/META.yml (added)
+++ branches/upstream/libfile-type-webimages-perl/current/META.yml Thu Dec 30 23:53:17 2010
@@ -1,0 +1,22 @@
+---
+name: File-Type-WebImages
+version: 1.01
+author:
+ - |-
+ Paul Mison <pmison at fotango.com> - wrote original File::Type
+ Mark Stosberg <mark at summersault.com> - hacked up this.
+abstract: determine web image file types using magic
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ IO::File: 0.01
+ Test::More: 0.01
+provides:
+ File::Type::WebImages:
+ file: lib/File/Type/WebImages.pm
+ version: 1.01
+generated_by: Module::Build version 0.2806
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: branches/upstream/libfile-type-webimages-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/Makefile.PL?rev=66670&op=file
==============================================================================
--- branches/upstream/libfile-type-webimages-perl/current/Makefile.PL (added)
+++ branches/upstream/libfile-type-webimages-perl/current/Makefile.PL Thu Dec 30 23:53:17 2010
@@ -1,0 +1,15 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+use ExtUtils::MakeMaker;
+WriteMakefile
+(
+ 'PL_FILES' => {},
+ 'INSTALLDIRS' => 'site',
+ 'NAME' => 'File::Type::WebImages',
+ 'EXE_FILES' => [],
+ 'VERSION_FROM' => 'lib/File/Type/WebImages.pm',
+ 'PREREQ_PM' => {
+ 'Test::More' => '0.01',
+ 'IO::File' => '0.01'
+ }
+ )
+;
Added: branches/upstream/libfile-type-webimages-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/README?rev=66670&op=file
==============================================================================
--- branches/upstream/libfile-type-webimages-perl/current/README (added)
+++ branches/upstream/libfile-type-webimages-perl/current/README Thu Dec 30 23:53:17 2010
@@ -1,0 +1,35 @@
+NAME
+
+File::Type - determine file type using magic
+
+INSTALLING
+
+Install using the standard Module::Build method:
+
+perl Build.PL
+
+./Build
+./Build test
+
+sudo ./Build install
+
+A Makefile.PL is also included if you do not have Module::Build:
+
+perl Makefile.PL
+
+make
+make test
+
+sudo make install
+
+USAGE
+
+my $ft = File::Type->new();
+
+# read in data from file to $data, then
+my $type_from_data = $ft->checktype_data($data);
+
+# alternatively, check file from disk
+my $type_from_file = $ft->checktype_filename($file);
+
+For further information, perldoc File::Type after installation.
Added: branches/upstream/libfile-type-webimages-perl/current/lib/File/Type/WebImages.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/lib/File/Type/WebImages.pm?rev=66670&op=file
==============================================================================
--- branches/upstream/libfile-type-webimages-perl/current/lib/File/Type/WebImages.pm (added)
+++ branches/upstream/libfile-type-webimages-perl/current/lib/File/Type/WebImages.pm Thu Dec 30 23:53:17 2010
@@ -1,0 +1,142 @@
+package File::Type::WebImages;
+use strict;
+use warnings;
+use base 'Exporter';
+use vars '@EXPORT_OK';
+ at EXPORT_OK = 'mime_type';
+
+use IO::File;
+
+our $VERSION = "1.01";
+
+sub mime_type {
+ # magically route argument
+
+ my $argument = shift;
+ return undef unless defined $argument;
+
+ if (length $argument > 1024 || $argument =~ m/\n/) {
+ # assume it's data. Saves a stat call if the data's long
+ # also avoids stat warning if there's a newline
+ return checktype_contents($argument);
+ }
+
+ if (-e $argument) {
+ if (!-d $argument) {
+ return checktype_filename($argument);
+ } else {
+ return undef; # directories don't have mime types
+ }
+ }
+ # otherwise, fall back to checking the string as if it's data again
+ return checktype_contents($argument);
+}
+
+# reads in 16k of selected file, or returns undef if can't open,
+# then checks contents
+sub checktype_filename {
+ my $filename = shift;
+ my $fh = IO::File->new($filename) || return undef;
+ my $data;
+ $fh->read($data, 16*1024);
+ $fh->close;
+ return checktype_contents($data);
+}
+
+# Matches $data against the magic database criteria and returns the MIME
+# type of the file.
+sub checktype_contents {
+ my $data = shift;
+ my $substr;
+
+ return undef unless defined $data;
+
+ if ($data =~ m[^\x89PNG]) {
+ return q{image/png};
+ }
+ elsif ($data =~ m[^GIF8]) {
+ return q{image/gif};
+ }
+ elsif ($data =~ m[^BM]) {
+ return q{image/bmp};
+ }
+
+ if (length $data > 1) {
+ $substr = substr($data, 1, 1024);
+ if (defined $substr && $substr =~ m[^PNG]) {
+ return q{image/png};
+ }
+ }
+ if (length $data > 0) {
+ $substr = substr($data, 0, 2);
+ if (pack('H*', 'ffd8') eq $substr ) {
+ return q{image/jpeg};
+ }
+ }
+
+ return undef;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Type::WebImages - determine web image file types using magic
+
+=head1 SYNOPSIS
+
+ use File::Type::WebImages 'mime_type';
+
+ my $type_1 = mime_type($file);
+ my $type_2 = mime_type($data);
+
+=head1 DESCRIPTION
+
+C<mime_type()> can use either a filename, or file contents, to determine the
+type of a file. The process involves looking the data at the beginning of the file,
+sometimes called "magic numbers".
+
+=head1 THE BIG TRADE OFF
+
+For minimum memory consumption, only the following common web image file types are supported:
+
+BMP, GIF, JPEG and PNG.
+( image/bmp, image/gif, image/jpeg and image/png ).
+
+Unlike with L<File::Type> and L<File::MMagic>, 'undef', not
+"application/octet-stream" will be returned for unknown formats.
+
+Unlike L<File::Type>, we return "image/png" for PNGs, I<not> "image/x-png";
+
+If you want more mime types detected use L<File::Type> or some other module.
+
+=head1 TODO
+
+It would be even better to have a pluggable system that would allow you
+to plug-in different sets of MIME-types you care about.
+
+=head1 SEE ALSO
+
+L<File::Type>. Similar, but supports over 100 file types.
+
+=head1 ACKNOWLEDGMENTS
+
+File::Type::WebImages is built from a mime-magic file from cleancode.org. The original
+can be found at L<http://cleancode.org/cgi-bin/viewcvs.cgi/email/mime-magic.mime?rev=1.1.1.1>.
+
+=head1 AUTHORS
+
+Paul Mison <pmison at fotango.com> - wrote original File::Type
+Mark Stosberg <mark at summersault.com> - hacked up this.
+
+=head1 COPYRIGHT
+
+Copyright 2003-2004 Fotango Ltd.
+
+=head1 LICENSE
+
+Licensed under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libfile-type-webimages-perl/current/t/01type.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/t/01type.t?rev=66670&op=file
==============================================================================
--- branches/upstream/libfile-type-webimages-perl/current/t/01type.t (added)
+++ branches/upstream/libfile-type-webimages-perl/current/t/01type.t Thu Dec 30 23:53:17 2010
@@ -1,0 +1,54 @@
+#!/usr/bin/perl -w
+use strict;
+
+use lib './lib','../lib';
+
+use File::Type::WebImages;
+use Test::More 'no_plan';
+
+=for testing
+
+Set up a list of files to test.
+
+=cut
+
+my $types = {
+ "files/blank.jpg" => "image/jpeg",
+ "files/blank.png" => "image/png",
+ "files/blank.gif" => "image/gif",
+ "files/blank.bmp" => "image/bmp",
+};
+
+=for testing
+
+Initialise the object.
+
+=cut
+
+=for testing
+
+Loop over the objects, testing each both ways.
+
+=cut
+
+for my $filename (sort keys %$types) {
+ my $mimetype = $types->{$filename};
+ is(File::Type::WebImages::checktype_filename("t/$filename"), $mimetype, "check file $filename");
+ my $data = read_file("t/$filename") || die;
+ is(File::Type::WebImages::checktype_contents($data), $mimetype, "check data $filename");
+}
+
+# edge cases
+is(File::Type::WebImages::checktype_contents(undef) , undef , "checktype_contents(undef) returns undef");
+is(File::Type::WebImages::checktype_contents('') , undef , "checktype_contents('') returns undef");
+
+sub read_file {
+ my $file = shift;
+
+ local $/ = undef;
+ open FILE, $file or die "Can't open file $file: $!";
+ my $data = <FILE>;
+ close FILE;
+
+ return $data;
+}
Added: branches/upstream/libfile-type-webimages-perl/current/t/02mime.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/t/02mime.t?rev=66670&op=file
==============================================================================
--- branches/upstream/libfile-type-webimages-perl/current/t/02mime.t (added)
+++ branches/upstream/libfile-type-webimages-perl/current/t/02mime.t Thu Dec 30 23:53:17 2010
@@ -1,0 +1,51 @@
+#!/usr/bin/perl -w
+use strict;
+
+use lib './lib','../lib';
+
+use File::Type::WebImages 'mime_type';
+use Test::More 'no_plan';
+
+my $types = {
+ "files/blank.jpg" => "image/jpeg",
+ "files/blank.png" => "image/png",
+ "files/blank.gif" => "image/gif",
+};
+
+=for testing
+
+Loop over the objects, testing each both ways.
+
+=cut
+
+for my $filename (sort keys %{ $types }) {
+ my $mimetype = $types->{$filename};
+ my $argument = $filename;
+ my $checktype;
+
+ # randomly read in file, or make filename correct
+ if (rand > 0.5) {
+ $argument = read_file("t/$filename") || die;
+ $checktype = 'data';
+ } else {
+ $argument = "t/".$argument;
+ $checktype = 'file';
+ }
+
+ is(mime_type($argument), $mimetype, "magically checked $checktype");
+}
+
+# some edge cases
+is(mime_type(undef) , undef , "undef input returns undef output");
+is(mime_type('') , undef , "zero-length input returns undef output");
+
+sub read_file {
+ my $file = shift;
+
+ local $/ = undef;
+ open FILE, $file or die "Can't open file $file: $!";
+ my $data = <FILE>;
+ close FILE;
+
+ return $data;
+}
Added: branches/upstream/libfile-type-webimages-perl/current/t/files/blank.bmp
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/t/files/blank.bmp?rev=66670&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libfile-type-webimages-perl/current/t/files/blank.bmp
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Added: branches/upstream/libfile-type-webimages-perl/current/t/files/blank.gif
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/t/files/blank.gif?rev=66670&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libfile-type-webimages-perl/current/t/files/blank.gif
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Added: branches/upstream/libfile-type-webimages-perl/current/t/files/blank.jpg
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/t/files/blank.jpg?rev=66670&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libfile-type-webimages-perl/current/t/files/blank.jpg
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
Added: branches/upstream/libfile-type-webimages-perl/current/t/files/blank.png
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libfile-type-webimages-perl/current/t/files/blank.png?rev=66670&op=file
==============================================================================
Binary file - no diff available.
Propchange: branches/upstream/libfile-type-webimages-perl/current/t/files/blank.png
------------------------------------------------------------------------------
svn:mime-type = application/octet-stream
More information about the Pkg-perl-cvs-commits
mailing list