Line # Revision Author
1 1 moose #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
6 use File::Spec;
7 use File::Spec::Functions;
8 our $dir;
9
10 if(exists $ENV{'KDEDIR'} && -d catdir($ENV{'KDEDIR'}, "share/mimelnk/text")) {
11 $dir = $ENV{'KDEDIR'};
12 # print "dir:$dir\n";
13 }
14 elsif(exists $ENV{'KDEDIRS'}) {
15 my @dirs = split ':', $ENV{'KDEDIRS'};
16 for my $diri (@dirs) {
17 my $d = catdir($diri, "share/mimelnk/text");
18 if(-d $d) {
19 $dir = $diri;
20 last;
21 }
22 }
23 if(!defined $dir || $dir eq "") {
24 $dir = "/usr/kde/3.5/";
25 }
26 # print "dirs:$dir\n";
27 }
28 else {
29 # print "default\n";
30 $dir = "/usr/kde/3.5/";
31 }
32
33 our $basemimedir = catdir($dir, "share/mimelnk");
34
35 scandir($basemimedir);
36
37 our @icons;
38 our %types;
39 our %exts;
40 our %pats;
41
42 sub scandir {
43 my $rdir = shift;
44 opendir(DIR, $rdir) or die "Failed to open $dir for listing: $!\n";
45
46 #use Data::Dumper;
47
48 for(readdir DIR) {
49 next if /^\..*/;
50 if(-d catdir($rdir, $_)) {
51 scandir(catdir($rdir, $_));
52 next;
53 }
54 #print "$_\n";
55 next if ! /\.desktop/;
56 my $path = catfile($rdir, $_);
57
58 if(!open(FH, $path)) {
59 warn "Failed to open $path for reading: $!\n";
60 next;
61 }
62
63 my %sects;
64 my $csect = '_default_';
65
66 for(<FH>) {
67 next if /^#.*/ || /^\s*$/;
68 chomp;
69 if(/^\[([^\]]+)\]/) {
70 $csect = $1;
71 $sects{$csect} = {} if ! exists $sects{$csect} || ref($sects{$csect}) ne "HASH";
72 next;
73 }
74 elsif(/^([^=]+)=(.*)$/) {
75 $sects{$csect}{$1} = $2;
76 }
77 }
78
79 #print Dumper(\%sects);
80 next if !exists $sects{"Desktop Entry"}{"Type"} || $sects{"Desktop Entry"}{"Type"} ne "MimeType";
81
82 # print $sects{"Desktop Entry"}{"Comment"} . ", " if exists $sects{"Desktop Entry"}{"Comment"};
83 # print $sects{"Desktop Entry"}{"MimeType"} . ", " if exists $sects{"Desktop Entry"}{"MimeType"};
84 # print $sects{"Desktop Entry"}{"Icon"} . ", " if exists $sects{"Desktop Entry"}{"Icon"};
85 # print $sects{"Desktop Entry"}{"Patterns"} if exists $sects{"Desktop Entry"}{"Patterns"};
86 # print "\n";
87
88 next if !exists $sects{"Desktop Entry"}{"MimeType"} || !defined $sects{"Desktop Entry"}{"MimeType"};
89 $types{$sects{"Desktop Entry"}{"MimeType"}} = {
90 comment => defined $sects{"Desktop Entry"}{"Comment"} ? $sects{"Desktop Entry"}{"Comment"} : "",
91 icon => defined $sects{"Desktop Entry"}{"Icon"} ? $sects{"Desktop Entry"}{"Icon"} : "",
92 patterns => defined $sects{"Desktop Entry"}{"Patterns"} ? $sects{"Desktop Entry"}{"Patterns"} : "",
93 };
94
95 push @icons, $sects{"Desktop Entry"}{"Icon"} if exists $sects{"Desktop Entry"}{"Icon"};
96
97 if(defined $sects{"Desktop Entry"}{"Patterns"}) {
98 my @exts = split ';', $sects{"Desktop Entry"}{"Patterns"};
99 for(@exts) {
100 $pats{$_} = defined $sects{"Desktop Entry"}{"MimeType"} ? $sects{"Desktop Entry"}{"MimeType"} : "";
101 s/\*//g;
102 $exts{$_} = defined $sects{"Desktop Entry"}{"MimeType"} ? $sects{"Desktop Entry"}{"MimeType"} : "";
103 }
104 }
105
106 close FH;
107 }
108
109 closedir DIR;
110 }
111
112 our @copy = qw/txt html source/;
113 our $icondir = catdir($dir, "share/icons/default.kde/32x32/mimetypes/");
114 for my $icon (@icons) {
115 my $cp = 0;
116 #for my $copy (@copy) { $cp = 1 if $icon =~ /$copy/; }
117 #next if !$cp;
118
119 my $path = catdir($icondir, $icon . ".png");
120 my $dest = catdir("./qrc", "images", $icon . ".png");
121 unlink $dest;
122 system ("ln -s $path $dest >/dev/null 2>&1") if -f $path;
123 #print "link, $path, $dest\n";
124 }
125
126 if(!open(FH, ">qrc/settings/mime.conf")) {
127 die "Failed to open mime.conf: $!\n";
128 }
129
130 print FH "[mime]\n";
131 for my $type (sort keys %types) {
132 print FH "types/" . $type . "/comment=" . (defined $types{$type}{"comment"} ? $types{$type}{"comment"} : "") . "\n";
133 print FH "types/" . $type . "/icon=" . (defined $types{$type}{"icon"} ? $types{$type}{"icon"} : "") . "\n";
134 print FH "types/" . $type . "/patterns=" . (defined $types{$type}{"patterns"} ? $types{$type}{"patterns"} : "") . "\n";
135 }
136
137 for my $ext (sort { lc($a) cmp lc($b) } keys %exts) {
138 print FH "extensions/" . $ext . "=" . $exts{$ext} . "\n";
139 }
140
141 for my $pat (sort { lc($a) cmp lc($b) } keys %pats) {
142 print FH "patterns/" . $pat . "=" . $pats{$pat} . "\n";
143 }
144
145 close FH;
146
147
148
149
150
151