#!/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() { 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;