Repository List / sciq4 / getmime.pl @ HEAD

#!/usr/bin/perl

use strict;
use warnings;

use File::Spec;
use File::Spec::Functions;
our $dir;

if(exists $ENV{'KDEDIR'} && -d catdir($ENV{'KDEDIR'}, "share/mimelnk/text")) {
	$dir = $ENV{'KDEDIR'};
#	print "dir:$dir\n";
}
elsif(exists $ENV{'KDEDIRS'}) {
	my @dirs = split ':', $ENV{'KDEDIRS'};
	for my $diri (@dirs) {
		my $d = catdir($diri, "share/mimelnk/text");
		if(-d $d) {
			$dir = $diri;
			last;
		}
	}
	if(!defined $dir || $dir eq "") {
		$dir = "/usr/kde/3.5/";
	}
#	print "dirs:$dir\n";
}
else {
#	print "default\n";
	$dir = "/usr/kde/3.5/";
}

our $basemimedir = catdir($dir, "share/mimelnk");

scandir($basemimedir);

our @icons;
our %types;
our %exts;
our %pats;

sub scandir {
	my $rdir = shift;
	opendir(DIR, $rdir) or die "Failed to open $dir for listing: $!\n";

	#use Data::Dumper;

	for(readdir DIR) {
		next if /^\..*/;
		if(-d catdir($rdir, $_)) {
			scandir(catdir($rdir, $_));
			next;
		}
		#print "$_\n";
		next if ! /\.desktop/;
		my $path = catfile($rdir, $_);

		if(!open(FH, $path)) {
			warn "Failed to open $path for reading: $!\n";
			next;
		}

		my %sects;
		my $csect = '_default_';

		for(<FH>) {
			next if /^#.*/ || /^\s*$/;
			chomp;
			if(/^\[([^\]]+)\]/) {
				$csect = $1;
				$sects{$csect} = {} if ! exists $sects{$csect} || ref($sects{$csect}) ne "HASH";
				next;
			}
			elsif(/^([^=]+)=(.*)$/) {
				$sects{$csect}{$1} = $2;
			}
		}

		#print Dumper(\%sects);
		next if !exists $sects{"Desktop Entry"}{"Type"} || $sects{"Desktop Entry"}{"Type"} ne "MimeType";

	#	print $sects{"Desktop Entry"}{"Comment"} . ", " if exists $sects{"Desktop Entry"}{"Comment"};
	#	print $sects{"Desktop Entry"}{"MimeType"} . ", " if exists $sects{"Desktop Entry"}{"MimeType"};
	#	print $sects{"Desktop Entry"}{"Icon"} . ", " if exists $sects{"Desktop Entry"}{"Icon"};
	#	print $sects{"Desktop Entry"}{"Patterns"} if exists $sects{"Desktop Entry"}{"Patterns"};
	#	print "\n";

		next if !exists $sects{"Desktop Entry"}{"MimeType"} || !defined $sects{"Desktop Entry"}{"MimeType"};
		$types{$sects{"Desktop Entry"}{"MimeType"}} = {
			comment => defined $sects{"Desktop Entry"}{"Comment"} ? $sects{"Desktop Entry"}{"Comment"} : "",
			icon => defined $sects{"Desktop Entry"}{"Icon"} ? $sects{"Desktop Entry"}{"Icon"} : "",
			patterns => defined $sects{"Desktop Entry"}{"Patterns"} ? $sects{"Desktop Entry"}{"Patterns"} : "",
		};

		push @icons, $sects{"Desktop Entry"}{"Icon"} if exists $sects{"Desktop Entry"}{"Icon"};

		if(defined $sects{"Desktop Entry"}{"Patterns"}) {
			my @exts = split ';', $sects{"Desktop Entry"}{"Patterns"};
			for(@exts) {
				$pats{$_} = defined $sects{"Desktop Entry"}{"MimeType"} ? $sects{"Desktop Entry"}{"MimeType"} : "";
				s/\*//g;
				$exts{$_} = defined $sects{"Desktop Entry"}{"MimeType"} ? $sects{"Desktop Entry"}{"MimeType"} : "";
			}
		}

		close FH;
	}

	closedir DIR;
}

our @copy = qw/txt html source/;
our $icondir = catdir($dir, "share/icons/default.kde/32x32/mimetypes/");
for my $icon (@icons) {
	my $cp = 0;
	#for my $copy (@copy) { $cp = 1 if $icon =~ /$copy/; }
	#next if !$cp;

	my $path = catdir($icondir, $icon . ".png");
	my $dest = catdir("./qrc", "images", $icon . ".png");
	unlink $dest;
	system ("ln -s $path $dest >/dev/null 2>&1") if -f $path;
	#print "link, $path, $dest\n";
}

if(!open(FH, ">qrc/settings/mime.conf")) {
	die "Failed to open mime.conf: $!\n";
}

print FH "[mime]\n";
for my $type (sort keys %types) {
	print FH "types/" . $type . "/comment=" . (defined $types{$type}{"comment"} ? $types{$type}{"comment"} : "") . "\n";
	print FH "types/" . $type . "/icon=" . (defined $types{$type}{"icon"} ? $types{$type}{"icon"} : "") . "\n";
	print FH "types/" . $type . "/patterns=" . (defined $types{$type}{"patterns"} ? $types{$type}{"patterns"} : "") . "\n";
}

for my $ext (sort { lc($a) cmp lc($b) } keys %exts) {
	print FH "extensions/" . $ext . "=" . $exts{$ext} . "\n";
}

for my $pat (sort { lc($a) cmp lc($b) } keys %pats) {
	print FH "patterns/" . $pat . "=" . $pats{$pat} . "\n";
}

close FH;