diff options
Diffstat (limited to 'scripts')
| -rwxr-xr-x | scripts/mimetype | 506 |
1 files changed, 31 insertions, 475 deletions
diff --git a/scripts/mimetype b/scripts/mimetype index 43c69ebc6..1d89d6922 100755 --- a/scripts/mimetype +++ b/scripts/mimetype @@ -1,482 +1,38 @@ -#!/usr/bin/perl - -eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' - if 0; # not running under some shell - -eval 'exec /usr/bin/perl -S $0 ${1+"$@"}' - if 0; # not running under some shell - +#!/usr/bin/perl +use warnings; use strict; -our $VERSION = '0.15'; -$|++; - -# ########## # -# Parse ARGV # -# ########## # -my %args = (); -my %opts = ( - # name => [char, expect_arg_bit ] - 'help' => ['h'], - 'usage' => ['u'], - 'version' => ['v'], - 'stdin' => [''], - 'brief' => ['b'], - 'namefile' => ['f', 1], - 'orig-name' => ['', 1], - 'noalign' => ['N'], - 'describe' => ['d'], - 'file-compat' => [''], - 'output-format' => ['', 1], - 'language' => ['l', 1], - 'mimetype' => ['i'], - 'dereference' => ['L'], - 'separator' => ['F',1], - 'debug' => ['D'], - 'database' => ['', 1], - 'all' => ['a'], - 'magic-only' => ['M'], -); - -$args{'file-compat'}++ if $0 =~ m#(^|/)file$#; - -while ((@ARGV) && ($ARGV[0] =~ /^-/)) { - my $opt = shift @ARGV; - if ($opt =~ /^--?$/) { - $args{stdin}++ if $args{'file-compat'} && $opt eq '-'; - last; - } - elsif ($opt =~ s/^--([\w-]+)(?:=(.*))?/$1/) { - if (exists $opts{$opt}) { - if ($opts{$opt}[1]) { - my $arg = $2 || shift @ARGV; - complain('--'.$opt, 2) unless defined $arg; - $args{$opt} .= ( $args{$opt} ? ' ' : '' ) . $arg; - } - else { $args{$opt}++ } - } - else { complain('--'.$opt) } - } - elsif ($opt =~ s/^-(?!-)//) { - foreach my $o (split //, $opt) { - my ($key) = grep { $opts{$_}[0] eq $o } keys %opts; - complain($o) unless $key; - - if ($opts{$key}[1]) { - my $arg = shift @ARGV; - complain('-'.$o, 2) unless defined $arg; - $args{$key} .= ( $args{$key} ? ' ' : '' ).$arg; # join with whitespace +use File::MimeInfo qw(mimetype globs); + +exit 1 unless @ARGV == 2; + +my $filename = $ARGV[0]; +my $file = $ARGV[1]; +my $type = ""; +my $file_type = ""; + +exit 1 unless -f $file; + +$type = globs($filename); + +# globbing takes priority over all other +if (!$type) { + $type = mimetype($file); + if ($type eq "application/octet-stream") { + # application/octet-stream normally means the detection failed + # use the output of file in this case + $file_type = `file -b --mime-type $file`; + chomp $file_type; + $type = $file_type; + if ($type eq "text/plain") { + # detect ascii with color codes + $file_type = `file -b $file`; + chomp $file_type; + if ($file_type eq "ASCII text, with escape sequences") { + $type = "text/plain-ascii"; } - else { $args{$key}++; } - } - } - else { complain($opt) } -} - -if ($args{help} || $args{usage}) { - eval 'use Pod::Usage'; - die "Could not find perl module Pod::Usage\n" if $@; - pod2usage( { - -verbose => 1, - -exitval => 0, - } ); -} - -if ($args{version}) { - print "mimetype $VERSION\n\n", << 'EOV'; -Copyright (c) 2003 Jaap G Karssenberg. All rights reserved. -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -EOV - exit 0; -} - -complain(undef, 4) unless scalar(@ARGV) || $args{stdin} || $args{namefile}; - -# ############# # -# prepare stuff # -# ############# # - -our %desc; # desc caching hash - -# --database -@File::MimeInfo::DIRS = split /:/, $args{database} if $args{database}; - -## Actually use our module ## -eval 'use File::MimeInfo::Magic qw/mimetype globs inodetype magic describe/;'; -die $@ if $@; - -*default = \&File::MimeInfo::default; - -# --debug -if ($args{debug}) { - $File::MimeInfo::DEBUG++; - $File::MimeInfo::Magic::DEBUG++; - print '> Data dirs are: ', join( ', ', - $args{database} - ? ( split /:/, $args{database} ) - : ( - File::BaseDir::xdg_data_home(), - File::BaseDir::xdg_data_dirs() - ) - ), "\n"; -} - -# --file-compat -$args{describe}++ if $args{'file-compat'} && !$args{mimetype}; - -# --namefile -if ($args{namefile}) { - open IN, $args{namefile} - || die "Couldn't open file: $args{namefile}\n"; - unshift @ARGV, map {chomp; $_} (<IN>); - close IN; -} - -# --language -$File::MimeInfo::LANG = $args{language} if $args{language}; - -# Formatting stuff -my $l = 5; # "STDIN" -unless ($args{brief} || $args{noalign}) { - for (@ARGV) { $l = length($_) if $l < length($_) } -} - -$args{separator} = ':' unless defined $args{separator}; -my $format = $args{'output-format'} - ? parse_format($args{'output-format'}) - : $args{brief} - ? sub { $args{describe} ? desc($_[1]) : $_[1] } - : $args{noalign} - ? sub { ( $_[0], $args{separator}, ' ', $args{describe} ? desc($_[1]) : $_[1] ) } - : sub { ( $_[0], $args{separator}, ' 'x($l + 1 - length($_[0])), - $args{describe} ? desc($_[1]) : $_[1] ) }; - -# --dereference -if ($args{dereference}) { - eval 'use File::Spec'; - die "Could not find perl module File::Spec\n" if $@; -} -# --stdin -if ($args{stdin}) { - eval 'use IO::Scalar'; - die "Could not find perl module IO::Scalar\n" if $@; -} - -# ######## # -# do stuff # -# ######## # - -# --stdin -if ($args{stdin}) { - my $data; - read(STDIN, $data, $File::MimeInfo::Magic::max_buffer); - my $scalar = new IO::Scalar \$data; - print $format->('STDIN', mimetype($scalar)), "\n"; - exit; -} - -foreach my $file (@ARGV) { - # --dereference - my $f = ($args{dereference} && -l $file) ? resolvelink($file) : $file; - # --magic-only - if ($args{'magic-only'}) { - print $format->($file, magic($f) || default($f)), "\n"; - } - # --all - elsif ($args{all}) { - for (qw#inodetype globs magic default#) { - my $m = eval "$_(\$f)"; - print $format->($file, $m), "\n" if $m; } } - elsif ($args{'orig-name'}) { - my $type = globs($args{'orig-name'}); - if ($type ne "") { - print $format->($file, $type), "\n"; - } else { - print $format->($file, mimetype($f)), "\n"; - } - } - else { print $format->($file, mimetype($f)), "\n" } -} - -exit; - -# ########### # -# Subroutines # -# ########### # - -sub complain { # Error messages - my $opt = shift; - my $m = shift || 1; - - my $bn = $0; - $bn =~ s|^(.*/)*||; - if ($m == 1) { print STDERR "$bn: unrecognized option '$opt'" } - elsif ($m == 2) { print STDERR "$bn: option '$opt' requires an argument" } - elsif ($m == 3) { print STDERR "$bn: $opt: No such file or directory\n" } - elsif ($m == 4) { print STDERR "usage: $bn [options] files" } - - print "\nTry '$bn --help' for more information.\n" unless $m == 3; - exit $m; } -sub parse_format { # Advanced formatting - my $form = shift; - my $code = "sub { '$form' }"; - # code will get @_ = qw/file type/ - $code =~ s/(?<!\\)%f/'.\$_[0].'/g; - $code =~ s/(?<!\\)%m/'.\$_[1].'/g; - $code =~ s/(?<!\\)%d/'.desc(\$_[1]).'/g; - return eval $code; -} - -sub resolvelink { # --dereference - my $file = shift; - my $link = readlink($file) || return $file; - my (undef, $dir, undef) = File::Spec->splitpath($file); - $link = File::Spec->rel2abs($link, $dir); - $link = resolvelink($link) if -l $link; # recurs - return $link; -} - -sub desc { # Cache desciption - my $mt = shift; - return undef unless $mt; - $desc{$mt} ||= describe($mt) || describe($mt, ''); # second form overrules the language settings to default -} - -__END__ - -=head1 NAME - -mimetype - Determine file type - -=head1 SYNOPSIS - -mimetype [options] [-] files - -=head1 DESCRIPTION - -This script tries to determine the mime type of a file using the -Shared MIME-info database. It is intended as a kind of I<file(1)> work-alike, -but uses mimetypes instead of descriptions. - -If one symlinks the I<file> command to I<mimetype> it will behave -a little more compatible, see L</--file-compat>. -Commandline options to specify alternative magic files are not -implemented the same because of the conflicting data formats. -Also the wording of the descriptions will differ. - -For naming switches I followed the manpage of file(1) version 4.02 -when possible. They seem to differ completely from the spec in the -'utilities' chapter of IEEE Std 1003.1-2001 (POSIX). - -=head1 OPTIONS - -=over 4 - -=item B<-a>, B<--all> - -Show output of all rules that match the file. - -TODO: this method now just returns one match for each -method (globs, magic, etc.). - -=item B<-b>, B<--brief> - -Do not prepend filenames to output lines (brief mode). - -=item B<--database>=I<mimedir>:I<mimedir>:... - -Force the program to look in these directories for the shared mime-info -database. The directories specified by the basedir specification -are ignored. - -=item B<-d>, B<--describe> - -Print file descriptions instead of mime types, this is the -default when using L</--file-compat>. - -=item B<-D>, B<--debug> - -Print debug information about how the mimetype was determined. - -=item B<-f> I<namefile>, B<--namefile>=I<namefile> - -Read the names of the files to be examined from the file 'namefile' -(one per line) before the argument list. - -=item B<--file-compat> - -Make mimetype behave a little more L<file(1)> compatible. This -is turned on automaticly when you call mimetype by a link -called 'file'. - -A single '-' won't be considered a seperator -between options and filenames anymore, but becomes identical to L</--stdin>. -( You can still use '--' as seperator, but -that is not backward compatible with the original file command. ) -Also the default becomes to print descriptions instead of mimetypes. - -=item B<-F> I<string>, B<--separator>=I<string> - -Use string as custom separator between the file name and its mimetype -or description, defaults to ':' . - -=item B<-h>, B<--help> - -=item B<-u>, B<--usage> - -Print a help message and exits. - -=item B<-i>, B<--mimetype> - -Use mime types, opposite to L</--describe>, -this is the default when _not_ using L</--file-compat>. - -=item B<-L>, B<--dereference> - -Follow symbolic links. - -=item B<-l> I<code>, B<--language>=I<code> - -The language attribute specifies a two letter language code, this makes -descriptions being outputted in the specified language. - -=item B<-M>, B<--magic-only> - -Do not check for extensions, globs or inode type, only look at the content -of the file. This is particularly useful if for some reason you don't trust -the name or the extension a file has. - -=item B<-N>, B<--noalign> - -Do not align output fields. - -=item B<--output-format> - -If you want an alternative output format, you can specify a format string -containing the following escapes: - - %f for the filename - %d description - %m mime type - -Alignment is not available when using this, -you need to post-process the output to do that. - -=item B<--stdin> - -Determine type of content from STDIN, less powerfull then normal file checking -because it only uses magic typing. This will happen also if the STDIN filehandle -is a pipe. - -To use this option L<IO::Scalar> needs to be installed. - -=item B<-v>, B<--version> - -Print the version of the program and exit. - -=back - -=head1 ENVIRONMENT - -=over 4 - -=item XDG_DATA_HOME - -=item XDG_DATA_DIRS - -These variables can list base directories to search for data files. The shared -mime-info will be expected in the "mime" sub directory of one of these -directories. If these are not set, there will be searched for the -following directories: - - $HOME/.local/share/mime - /usr/local/share/mime - /usr/share/mime - -See also the "XDG Base Directory Specification" -L<http://freedesktop.org/Standards/basedir-spec> - -=back - -=head1 FILES - -The base dir for all data files is determined by two environment variables, -see L</ENVIRONMENT>. - -=over 4 - -=item F<BASE/mime/packages/SOURCE.xml> - -All other files are compiled from these source files. To re-compile them -use B<update-mime-database(1)>. - -=item F<BASE/mime/globs> - -Compiled information about globs. - -=item F<BASE/mime/magic> - -Compiled information about magic numbers. - -=item F<BASE/mime/MEDIA/SUBTYPE.xml> - -Descriptions of a mimetype in multiple languages, used for the -L</--describe> switch. - -=back - -=head1 DIAGNOSTICS - -If a file has an empty mimetype or an empty description, -most probably the file doesn't exist and the given name -doesn't match any globs. An empty description can also mean that -there is no description available in the language you specified. - -The program exits with a non-zero exit value if either the commandline -arguments failed, a module it depends on wasn't found or the shared -mime-info database wasn't accesable. See L<File::MimeInfo> for more details. - -=head1 TODO - -The '--all' switch doesn't really show all matches, but only one per -mime-typing method. This needs to be implemnted in the modules first. - -=head1 BUGS - -No known bugs, please mail the author if you find one. - -B<mimetype> doesn't provide a switch for looking inside compressed files -because it seems to me that this can only be done by un-compressing the file, -something that defeats the purpose. On the other hand the option should -exist for strict compatibility with file(1). Possibly a subclass should be -made for this one day. - -=head1 AUTHOR - -Jaap Karrssenberg E<lt>pardus@cpan.orgE<gt> - -=head1 COPYRIGHT - -Copyright (c) 2003,2008 Jaap G Karssenberg. All rights reserved. -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl. - -This program is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -=head1 SEE ALSO - -L<file(1)>, -L<update-mime-database(1)>, -L<File::MimeInfo(3)>, -L<http://freedesktop.org/Software/shared-mime-info> +print "$type\n"; |