This file is indexed.

/usr/share/perl5/File/MimeInfo/Applications.pm is in libfile-mimeinfo-perl 0.22-1.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
package File::MimeInfo::Applications;

use strict;
use Carp;
use File::Spec;
use File::BaseDir qw/data_home data_dirs data_files/;
use File::MimeInfo qw/mimetype_canon mimetype_isa/;
use File::DesktopEntry;
require Exporter;

our $VERSION = '0.22';

our @ISA = qw(Exporter);
our @EXPORT = qw(
	mime_applications mime_applications_all
	mime_applications_set_default mime_applications_set_custom
);

print STDERR << 'EOT' unless data_files(qw/applications mimeinfo.cache/);
WARNING: You don't seem to have any mimeinfo.cache files.
Try running the update-desktop-database command. If you
don't have this command you should install the
desktop-file-utils package. This package is available from
http://freedesktop.org/wiki/Software_2fdesktop_2dfile_2dutils
EOT

sub mime_applications {
	croak "usage: mime_applications(MIMETYPE)" unless @_ == 1;
	my $mime = mimetype_canon(shift @_);
	local $Carp::CarpLevel = $Carp::CarpLevel + 1;
	return wantarray ? (_default($mime), _others($mime)) : _default($mime);
}

sub mime_applications_all {
	croak "usage: mime_applications(MIMETYPE)" unless @_ == 1;
	my $mime = shift;
	return mime_applications($mime),
		grep defined($_), map mime_applications($_), mimetype_isa($mime);
}

sub mime_applications_set_default {
	croak "usage: mime_applications_set_default(MIMETYPE, APPLICATION)"
		unless @_ == 2;
	my ($mimetype, $desktop_file) = @_;
	(undef, undef, $desktop_file) =
		File::Spec->splitpath($desktop_file->{file})
		if ref $desktop_file;
	croak "missing desktop entry filename for application"
		unless length $desktop_file;
	$desktop_file .= '.desktop' unless $desktop_file =~ /\.desktop$/;
	_write_list($mimetype, $desktop_file);
}

sub mime_applications_set_custom {
	croak "usage: mime_applications_set_custom(MIMETYPE, COMMAND)"
		unless @_ == 2;
	my ($mimetype, $command) = @_;
	$command =~ /(\w+)/;
	my $word = $1 or croak "COMMAND does not contain a word !?";

	# Algorithm to generate name copied from other implementations
	my $i = 1;
	my $desktop_file =
		data_home('applications', $word.'-usercreated-'.$i.'.desktop');
	while (-e $desktop_file) {
		$i++;
		$desktop_file =
		data_home('applications', $word.'-usercreated-'.$i.'.desktop');
	}

	my $object = File::DesktopEntry->new();
	$object->set(
		Type      => 'Application',
		Name      => $word,
		NoDsiplay => 'true',
		Exec      => $command,
	);
	my (undef, undef, $df) = File::Spec->splitpath($desktop_file);
	_write_list($mimetype, $df); # creates dir if needed
	$object->write($desktop_file);
	return $object;
}

sub _default {
	my $mimetype = shift;
	my $file = data_home(qw/applications defaults.list/);
	return undef unless -f $file && -r _;

	$Carp::CarpLevel++;
	my @list = _read_list($mimetype, $file);
	my $desktop_file = _find_file(reverse @list);
	$Carp::CarpLevel--;

	return $desktop_file;
}

sub _others {
	my $mimetype = shift;

	$Carp::CarpLevel++;
	my (@list, @done);
	for my $dir (data_dirs('applications')) {
		my $cache = File::Spec->catfile($dir, 'mimeinfo.cache');
		next if grep {$_ eq $cache} @done;
		push @done, $cache;
		next unless -f $cache and -r _;
		for (_read_list($mimetype, $cache)) {
			my $file = File::Spec->catfile($dir, $_);
			next unless -f $file and -r _;
			push @list, File::DesktopEntry->new($file);
		}
	}
	$Carp::CarpLevel--;

	return @list;
}

sub _read_list { # read list with "mime/type=foo.desktop;bar.desktop" format
	my ($mimetype, $file) = @_;
	my @list;
	open LIST, '<', $file or croak "Could not read file: $file";
	while (<LIST>) {
		/^$mimetype=(.*)$/ or next;
		push @list, grep defined($_), split ';', $1;
	}
	close LIST;

	return @list;
}

sub _write_list {
	my ($mimetype, $desktop_file) = @_;
	my $file = data_home(qw/applications defaults.list/);
	my $text;
	if (-f $file) {
		open LIST, '<', $file or croak "Could not read file: $file";
		while (<LIST>) {
			$text .= $_ unless /^$mimetype=/;
		}
		close LIST;
		$text =~ s/[\n\r]?$/\n/; # just to be sure
	}
	else {
		_mkdir($file);
		$text = "[Default Applications]\n";
	}

	open LIST, '>', $file or croak "Could not write file: $file";
	print LIST $text;
	print LIST "$mimetype=$desktop_file;\n";
	close LIST or croak "Could not write file: $file";
}

sub _find_file {
	my @list = shift;
	for (@list) {
		my $file = data_files('applications', $_);
		return File::DesktopEntry->new($file) if $file;
	}
	return undef;
}

sub _mkdir {
	my $dir = shift;
	return if -d $dir;

	my ($vol, $dirs, undef) = File::Spec->splitpath($dir);
	my @dirs = File::Spec->splitdir($dirs);
	my $path = File::Spec->catpath($vol, shift @dirs);
	while (@dirs) {
		mkdir $path; # fails silently
		$path = File::Spec->catdir($path, shift @dirs);
	}

	die "Could not create dir: $path\n" unless -d $path;
}

1;

__END__

=head1 NAME

File::MimeInfo::Applications - Find programs to open a file by mimetype

=head1 SYNOPSIS

  use File::MimeInfo::Magic;
  use File::MimeInfo::Applications;

  my $file = '/foo/bar';
  my $mimetype = mimetype($file)
      || die "Could not find mimetype for $file\n";

  my ($default, @other) = mime_applications($mimetype);

  if (defined $default) {
      $default->system($file)
  }
  else {
	  # prompt user with choice from @others
	  # ...
  }

=head1 DESCRIPTION

This module tries to find applications that can open files
with a certain mimetype. This is done in the way suggested by
the freedesktop Desktop Entry specification. This module is
intended to be compatible with file managers and other applications that
implement this specification.

This module depends on L<File::DesktopEntry> being installed.

To use this module effectively you need to have the desktop-file-utils
package from freedesktop and run update-desktop-database after installing
new .desktop files.
See L<http://www.freedesktop.org/wiki/Software/desktop-file-utils>.

At the moment of writing this module is compatible with the way Nautilus (Gnome)
and with Thunar (XFCE) handle applications for mimetypes. I understand KDE
is still working on implementing the freedesktop mime specifications but will
follow. At the very least all perl applications using this module are using
the same defaults.

=head1 EXPORT

All methods are exported by default.

=head1 METHODS

=over 4

=item C<mime_applications(MIMETYPE)>

Returns an array of L<File::DesktopEntry> objects. The first
is the default application for this mimetype, the rest are
applications that say they can handle this mimetype.

If the first result is undefined there is no default application
and it is good practice to ask the user which application he wants
to use.

=item C<mime_applications_all(MIMETYPE)>

Like C<mime_applications()> but also takes into account applications that
can open mimetypes from which MIMETYPE inherits. Parent mimetypes tell
something about the data format, all code inherits from text/plain for example.

=item C<mime_applications_set_default(MIMETYPE, APPLICATION)>

Save a default application for this mimetype. This action will
affect other applications using the same mechanism to find a default
application.

APPLICATION can either be a File::DesktopEntry object or
the basename of a .desktop file.

=item C<mime_applications_set_custom(MIMETYPE, COMMAND)>

Save a custom shell command as default application.
Generates a DesktopEntry file on the fly and calls
C<mime_applications_set_custom>.
Returns the DesktopEntry object.

No checks are done at all on COMMAND.
It should however contain at least one word.

=back

=head1 NOTES

At present the file with defaults is
F<$XDG_DATA_HOME/applications/defaults.list>.
This file is not specified in any freedesktop spec and if it gets standardized
it should probably be located in C<$XDG_CONFIG_HOME>. For this module I tried
to implement the status quo.

=head1 AUTHOR

Jaap Karssenberg E<lt>pardus@cpan.orgE<gt>
Maintained by Michiel Beijen E<lt>michiel.beijen@gmail.comE<gt>

=head1 COPYRIGHT

Copyright (c) 2005, 2012 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 itself.

=head1 SEE ALSO

L<File::DesktopEntry>,
L<File::MimeInfo>,
L<File::MimeInfo::Magic>,
L<File::BaseDir>

L<http://freedesktop.org/wiki/Software_2fdesktop_2dfile_2dutils>

=cut