#!/usr/bin/perl

use strict;
use File::MimeInfo qw/mimetype describe/;

our $VERSION = '0.3';

$|++;

# ########## #
# Parse ARGV #
# ########## #
my %args = ();
my %opts = (
	# name	=> [char, expect_arg_bit ]
	'help'		=> ['h'],
	'usage'		=> ['u'],
	'version'	=> ['v'],
	'stdin'		=> ['s'],
	'brief'		=> ['b'],
	'namefile'	=> ['f', 1],
	'noalign',	=> ['N'],
	'describe',	=> ['d'],
	'file-compat'	=> [''],
	'output-format'	=> ['', 1],
	'language'	=> ['', 1],
	'mimetype'	=> ['i'],
	'dereference'	=> ['L'],
);

$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('--'.$opt, 2);
				$args{$key} .= ( $args{$key} ? ' ' : '' ).$arg; # join with whitespace
			}
			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 #
# ############# #

# compat moet al eerder in de parsing gehackt due to '-' for stdin
die "TODO - read from stdin - need magic\n" if $args{stdin};

$args{describe}++ if $args{'file-compat'} && !$args{mimetype};

if ($args{namefile}) {
	open IN, $args{namefile} 
		|| die "Couldn't open file: $args{namefile}\n";
	unshift @ARGV, map {chomp; $_} (<IN>);
	close IN;
}

my $l;
unless ($args{brief} || $args{noalign}) {
	for (@ARGV) { $l = length($_) if $l < length($_) }
}

$File::MimeInfo::LANG = $args{language} if $args{language};

my $format = $args{'output-format'} ? parse_format($args{'output-format'}) : undef;

if ($args{dereference}) {
	eval 'use File::Spec';
	die "Could not find perl module File::Spec\n" if $@;
}

# ######## #
# do stuff #
# ######## #

foreach my $file (@ARGV) {
	my $type;

	if (-l $file && $args{dereference}) { $type = mimetype(resolvelink($file)) }
	else {$type = mimetype($file) }

	unless ($args{brief} || $format) {
		print $file, ': ';
		print ' 'x($l-length($file)) unless $args{noalign};
	}

	if    ($format)		{ print $format->($file, $type, describe($type)), "\n" }
	elsif ($args{describe})	{ print describe($type), "\n" }
	else			{ print $type, "\n" }
}

# ########### #
# Subroutines #
# ########### #

sub complain {
	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 {
	my $form = shift;
	my $code = "sub { '$form' }";
	# code will get @_ = qw/file type desc/
	$code =~ s/(?<!\\)%f/'.\$_[0].'/g;
	$code =~ s/(?<!\\)%m/'.\$_[1].'/g;
	$code =~ s/(?<!\\)%d/'.\$_[2].'/g;
	return eval $code;
}

sub resolvelink {
	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;
}

__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.

=head1 OPTIONS

=over 4

=item B<-b>, B<--brief>

Do not prepend filenames to output lines (brief mode).

=item B<-d>, B<--describe>

Print file descriptions instead of mime types, this is the
default when using L<--file-compat>.

=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<-s>.
( 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<-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<--language>=I<language>

The language attribute specifies a two letter language code, this makes
descriptions being outputted in the specified language.

=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<-s>, B<--stdin>

Determine type of content from STDIN.

=item B<-v>, B<--version>

Print the version of the program and exit.

=back

=head1 ENVIRONMENT

See L<File::MimeInfo>.

=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 on this last case.

=head1 TODO

Since L<File::MimeInfo> currently only uses globs and doesn't do any real magic parsing,
reading from stdin wasn't implemented yet.

=head1 BUGS

No known bugs, please mail the author if you find one.

=head1 AUTHOR

Jaap Karrssenberg E<lt>pardus@cpan.orgE<gt>

=head1 COPYRIGHT

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.

=head1 SEE ALSO

L<file(1)>,
L<update-mime-database(1)>,
L<File::MimeInfo(3)>,
L<http://www.freedesktop.org/software/shared-mime-info/>

