File Coverage

blib/lib/Linux/DesktopFiles.pm
Criterion Covered Total %
statement 54 95 56.8
branch 18 62 29.0
condition 7 33 21.2
subroutine 4 6 66.6
pod 5 5 100.0
total 88 201 43.7


line stmt bran cond sub pod time code
1             package Linux::DesktopFiles;
2              
3             # This module is designed to be pretty fast.
4             # The best uses of this module is to generate real
5             # time menus, based on the content of desktop files.
6              
7 1     1   45728 use 5.014;
  1         3  
8              
9             #use strict;
10             #use warnings;
11              
12             our $VERSION = '0.25';
13              
14             our %TRUE_VALUES = (
15             'true' => 1,
16             'True' => 1,
17             '1' => 1
18             );
19              
20             sub new {
21 1     1 1 69 my ($class, %opt) = @_;
22              
23             my %data = (
24             keep_unknown_categories => 0,
25             unknown_category_key => 'Other',
26              
27             case_insensitive_cats => 0,
28              
29             skip_filename_re => undef,
30             skip_entry => undef,
31             substitutions => undef,
32              
33 1 50       16 terminal => (defined($opt{terminal}) ? undef : $ENV{TERM}),
34              
35             terminalize => 0,
36             terminalization_format => q{%s -e '%s'},
37              
38             desktop_files_paths => [
39             qw(
40             /usr/local/share/applications
41             /usr/share/applications
42             )
43             ],
44              
45             keys_to_keep => [qw(Exec Name Icon)],
46              
47             categories => [
48             qw(
49             Utility
50             Development
51             Education
52             Game
53             Graphics
54             AudioVideo
55             Network
56             Office
57             Settings
58             System
59             )
60             ],
61              
62             %opt,
63             );
64              
65 1         3 $data{_file_keys_re} = do {
66 1         1 my %seen;
67 10         16 my @keys = map { quotemeta($_) } grep { !$seen{$_}++ }
  10         19  
68 1 50       2 (@{$data{keys_to_keep}}, qw(Hidden NoDisplay Categories), ($data{terminalize} ? qw(Terminal) : ()));
  1         4  
69              
70 1         2 local $" = q{|};
71 1         57 qr/^(@keys)=(.*\S)/m;
72             };
73              
74 1 50       4 if ($data{case_insensitive_cats}) {
75 0         0 @{$data{_categories}}{map { (lc $_) =~ tr/_a-z0-9/_/cr } @{$data{categories}}} = ();
  0         0  
  0         0  
  0         0  
76             }
77             else {
78 1         2 @{$data{_categories}}{@{$data{categories}}} = ();
  1         4  
  1         1  
79             }
80              
81 1         4 bless \%data, $class;
82             }
83              
84             sub get_desktop_files {
85 0     0 1 0 my ($self) = @_;
86              
87 0         0 my %table;
88 0         0 foreach my $dir (@{$self->{desktop_files_paths}}) {
  0         0  
89 0 0       0 opendir(my $dir_h, $dir) or next;
90              
91             #<<<
92 0   0     0 my $is_local = (
93             index($dir, '/local/') != -1
94             or index($dir, '/.local/') != -1
95             );
96             #>>>
97              
98 0         0 foreach my $file (readdir $dir_h) {
99 0 0       0 if (substr($file, -8) eq '.desktop') {
100 0 0 0     0 if ($is_local or not exists($table{$file})) {
101 0         0 $table{$file} = "$dir/$file";
102             }
103             }
104             }
105             }
106              
107 0 0       0 wantarray ? values(%table) : [values(%table)];
108             }
109              
110             # Used for unescaping strings
111             my %Chr = (s => ' ', n => "\n", r => "\r", t => "\t", '\\' => '\\');
112              
113             sub parse_desktop_file {
114 2     2 1 1626 my ($self, $desktop_file) = @_;
115              
116             # Check the filename and skip it if it matches `skip_filename_re`
117 2 50       8 if (defined $self->{skip_filename_re}) {
118 0 0       0 substr($desktop_file, rindex($desktop_file, '/') + 1) =~ /$self->{skip_filename_re}/ && return;
119             }
120              
121             # Open and read the desktop file
122 2 50       42 sysopen my $desktop_fh, $desktop_file, 0 or return;
123 2         19 sysread $desktop_fh, (my $file), -s $desktop_file;
124              
125             # Locate the "[Desktop Entry]" section
126 2 50       16 if ((my $index = index($file, "]\n", index($file, "[Desktop Entry]") + 15)) != -1) {
127 2         8 $file = substr($file, 0, $index);
128             }
129              
130             # Parse the entry data
131 2         39 my %info = $file =~ /$self->{_file_keys_re}/g;
132              
133             # Ignore the file when `NoDisplay` is true
134 2 50       7 if (exists $info{NoDisplay}) {
135 0 0       0 return if exists $TRUE_VALUES{$info{NoDisplay}};
136             }
137              
138             # Ignore the file when `Hidden` is true
139 2 50       5 if (exists $info{Hidden}) {
140 0 0       0 return if exists $TRUE_VALUES{$info{Hidden}};
141             }
142              
143             # If no 'Name' entry is defined, create one with the name of the file
144 2   33     4 $info{Name} //= substr($desktop_file, rindex($desktop_file, '/') + 1, -8);
145              
146             # Unescape string escapes (\n, \t, etc.)
147 2   0     13 $info{$_} =~ s{\\(.)}{ $Chr{$1} // $1 }eg for (keys %info);
  0         0  
148              
149             # Handle `skip_entry`
150 2 50 33     6 if (defined($self->{skip_entry}) and ref($self->{skip_entry}) eq 'ARRAY') {
151 0         0 foreach my $pair_ref (@{$self->{skip_entry}}) {
  0         0  
152 0 0 0     0 if (exists($info{$pair_ref->{key}}) and $info{$pair_ref->{key}} =~ /$pair_ref->{re}/) {
153 0         0 return;
154             }
155             }
156             }
157              
158             # Make user-defined substitutions
159 2 50 33     6 if (defined($self->{substitutions}) and ref($self->{substitutions}) eq 'ARRAY') {
160 0         0 foreach my $pair_ref (@{$self->{substitutions}}) {
  0         0  
161 0 0       0 if (exists $info{$pair_ref->{key}}) {
162 0 0       0 if ($pair_ref->{global}) {
163 0         0 $info{$pair_ref->{key}} =~ s/$pair_ref->{re}/$pair_ref->{value}/g;
164             }
165             else {
166 0         0 $info{$pair_ref->{key}} =~ s/$pair_ref->{re}/$pair_ref->{value}/;
167             }
168             }
169             }
170             }
171              
172             # Parse categories (and remove any duplicates)
173 2         2 my %categories;
174              
175             #<<<
176             @categories{
177 8         15 grep { exists $self->{_categories}{$_} } (
178             $self->{case_insensitive_cats}
179 0         0 ? (map { lc($_) =~ tr/_a-z0-9/_/cr } split(/;/, $info{Categories} // ''))
180 2 50 0     12 : (split(/;/, $info{Categories} // ''))
      50        
181             )
182             } = ();
183             #>>>
184              
185 2         6 my @cats = keys %categories;
186              
187             # Skip entry when there are no categories and `keep_unknown_categories` is false
188             # When `keep_unknown_categories` is true, set `@cats` to `unknown_category_key`.
189 2 50       4 if (!@cats) {
190 0 0       0 if ($self->{keep_unknown_categories}) {
191 0         0 push @cats, $self->{unknown_category_key};
192             }
193             else {
194 0         0 return;
195             }
196             }
197              
198             # Store the categories
199 2         4 $info{Categories} = \@cats;
200              
201             # Remove `% ...` from the value of `Exec`
202 2 50       12 index($info{Exec}, ' %') != -1 and $info{Exec} =~ s/ +%.*//s;
203              
204             # Terminalize
205 2 0 33     7 if ( $self->{terminalize}
      33        
206             and defined($info{Terminal})
207             and exists($TRUE_VALUES{$info{Terminal}})) {
208 0         0 $info{Exec} = sprintf($self->{terminalization_format}, $self->{terminal}, $info{Exec});
209             }
210              
211             # Check and clean the icon name
212 2 50       11 if (exists $info{Icon}) {
213 2         4 my $icon = $info{Icon};
214              
215 2         2 my $abs;
216 2 50       6 if (substr($icon, 0, 1) eq '/') {
217 0 0       0 if (-f $icon) { # icon is specified as an absolute path
218 0         0 $abs = 1;
219             }
220             else { # otherwise, take its basename
221 0         0 $icon = substr($icon, 1 + rindex($icon, '/'));
222             }
223             }
224              
225             # Remove any icon extension
226 2 50       3 if (!$abs) {
227 2         4 $icon =~ s/\.(?:png|jpe?g|svg|xpm)\z//i;
228             }
229              
230             # Store the icon back into `%info`
231 2         3 $info{Icon} = $icon;
232             }
233              
234 2 100       27 wantarray ? (%info) : \%info;
235             }
236              
237             sub parse {
238 1     1 1 18 my ($self, $hash_ref, @desktop_files) = @_;
239              
240 1         3 foreach my $desktop_file (@desktop_files) {
241 1   50     2 my $entry = $self->parse_desktop_file($desktop_file) // next;
242              
243             # Push the entry into its belonging categories
244 1         3 foreach my $category (@{$entry->{Categories}}) {
  1         2  
245 1         2 push @{$hash_ref->{$category}}, $entry;
  1         3  
246             }
247             }
248              
249 1         3 $hash_ref;
250             }
251              
252             sub parse_desktop_files {
253 0     0 1   my ($self) = @_;
254 0           my %categories;
255 0           $self->parse(\%categories, $self->get_desktop_files);
256 0 0         wantarray ? (%categories) : \%categories;
257             }
258              
259             1;
260              
261             __END__