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

package Linux::DesktopFiles;

# This module is designed to be pretty fast.
# The best uses of this module is to generate real
# time menus, based on the content of desktop files.

use 5.014;

#use strict;
#use warnings;

our $VERSION = '0.25';

our %TRUE_VALUES = (
                    'true' => 1,
                    'True' => 1,
                    '1'    => 1
                   );

sub new {
    my ($class, %opt) = @_;

    my %data = (
        keep_unknown_categories => 0,
        unknown_category_key    => 'Other',

        case_insensitive_cats => 0,

        skip_filename_re => undef,
        skip_entry       => undef,
        substitutions    => undef,

        terminal => (defined($opt{terminal}) ? undef : $ENV{TERM}),

        terminalize            => 0,
        terminalization_format => q{%s -e '%s'},

        desktop_files_paths => [
            qw(
              /usr/local/share/applications
              /usr/share/applications
              )
        ],

        keys_to_keep => [qw(Exec Name Icon)],

        categories => [
            qw(
              Utility
              Development
              Education
              Game
              Graphics
              AudioVideo
              Network
              Office
              Settings
              System
              )
        ],

        %opt,
               );

    $data{_file_keys_re} = do {
        my %seen;
        my @keys = map { quotemeta($_) } grep { !$seen{$_}++ }
          (@{$data{keys_to_keep}}, qw(Hidden NoDisplay Categories), ($data{terminalize} ? qw(Terminal) : ()));

        local $" = q{|};
        qr/^(@keys)=(.*\S)/m;
    };

    if ($data{case_insensitive_cats}) {
        @{$data{_categories}}{map { (lc $_) =~ tr/_a-z0-9/_/cr } @{$data{categories}}} = ();
    }
    else {
        @{$data{_categories}}{@{$data{categories}}} = ();
    }

    bless \%data, $class;
}

sub get_desktop_files {
    my ($self) = @_;

    my %table;
    foreach my $dir (@{$self->{desktop_files_paths}}) {
        opendir(my $dir_h, $dir) or next;

#<<<
        my $is_local = (
               index($dir,  '/local/') != -1
            or index($dir, '/.local/') != -1
        );
#>>>

        foreach my $file (readdir $dir_h) {
            if (substr($file, -8) eq '.desktop') {
                if ($is_local or not exists($table{$file})) {
                    $table{$file} = "$dir/$file";
                }
            }
        }
    }

    wantarray ? values(%table) : [values(%table)];
}

# Used for unescaping strings
my %Chr = (s => ' ', n => "\n", r => "\r", t => "\t", '\\' => '\\');

sub parse_desktop_file {
    my ($self, $desktop_file) = @_;

    # Check the filename and skip it if it matches `skip_filename_re`
    if (defined $self->{skip_filename_re}) {
        substr($desktop_file, rindex($desktop_file, '/') + 1) =~ /$self->{skip_filename_re}/ && return;
    }

    # Open and read the desktop file
    sysopen my $desktop_fh, $desktop_file, 0 or return;
    sysread $desktop_fh, (my $file), -s $desktop_file;

    # Locate the "[Desktop Entry]" section
    if ((my $index = index($file, "]\n", index($file, "[Desktop Entry]") + 15)) != -1) {
        $file = substr($file, 0, $index);
    }

    # Parse the entry data
    my %info = $file =~ /$self->{_file_keys_re}/g;

    # Ignore the file when `NoDisplay` is true
    if (exists $info{NoDisplay}) {
        return if exists $TRUE_VALUES{$info{NoDisplay}};
    }

    # Ignore the file when `Hidden` is true
    if (exists $info{Hidden}) {
        return if exists $TRUE_VALUES{$info{Hidden}};
    }

    # If no 'Name' entry is defined, create one with the name of the file
    $info{Name} //= substr($desktop_file, rindex($desktop_file, '/') + 1, -8);

    # Unescape string escapes (\n, \t, etc.)
    $info{$_} =~ s{\\(.)}{ $Chr{$1} // $1 }eg for (keys %info);

    # Handle `skip_entry`
    if (defined($self->{skip_entry}) and ref($self->{skip_entry}) eq 'ARRAY') {
        foreach my $pair_ref (@{$self->{skip_entry}}) {
            if (exists($info{$pair_ref->{key}}) and $info{$pair_ref->{key}} =~ /$pair_ref->{re}/) {
                return;
            }
        }
    }

    # Make user-defined substitutions
    if (defined($self->{substitutions}) and ref($self->{substitutions}) eq 'ARRAY') {
        foreach my $pair_ref (@{$self->{substitutions}}) {
            if (exists $info{$pair_ref->{key}}) {
                if ($pair_ref->{global}) {
                    $info{$pair_ref->{key}} =~ s/$pair_ref->{re}/$pair_ref->{value}/g;
                }
                else {
                    $info{$pair_ref->{key}} =~ s/$pair_ref->{re}/$pair_ref->{value}/;
                }
            }
        }
    }

    # Parse categories (and remove any duplicates)
    my %categories;

#<<<
        @categories{
            grep { exists $self->{_categories}{$_} } (
                      $self->{case_insensitive_cats}
                      ? (map { lc($_) =~ tr/_a-z0-9/_/cr } split(/;/, $info{Categories} // ''))
                      : (split(/;/, $info{Categories} // ''))
            )
        } = ();
#>>>

    my @cats = keys %categories;

    # Skip entry when there are no categories and `keep_unknown_categories` is false
    # When `keep_unknown_categories` is true, set `@cats` to `unknown_category_key`.
    if (!@cats) {
        if ($self->{keep_unknown_categories}) {
            push @cats, $self->{unknown_category_key};
        }
        else {
            return;
        }
    }

    # Store the categories
    $info{Categories} = \@cats;

    # Remove `% ...` from the value of `Exec`
    index($info{Exec}, ' %') != -1 and $info{Exec} =~ s/ +%.*//s;

    # Terminalize
    if (    $self->{terminalize}
        and defined($info{Terminal})
        and exists($TRUE_VALUES{$info{Terminal}})) {
        $info{Exec} = sprintf($self->{terminalization_format}, $self->{terminal}, $info{Exec});
    }

    # Check and clean the icon name
    if (exists $info{Icon}) {
        my $icon = $info{Icon};

        my $abs;
        if (substr($icon, 0, 1) eq '/') {
            if (-f $icon) {    # icon is specified as an absolute path
                $abs = 1;
            }
            else {             # otherwise, take its basename
                $icon = substr($icon, 1 + rindex($icon, '/'));
            }
        }

        # Remove any icon extension
        if (!$abs) {
            $icon =~ s/\.(?:png|jpe?g|svg|xpm)\z//i;
        }

        # Store the icon back into `%info`
        $info{Icon} = $icon;
    }

    wantarray ? (%info) : \%info;
}

sub parse {
    my ($self, $hash_ref, @desktop_files) = @_;

    foreach my $desktop_file (@desktop_files) {
        my $entry = $self->parse_desktop_file($desktop_file) // next;

        # Push the entry into its belonging categories
        foreach my $category (@{$entry->{Categories}}) {
            push @{$hash_ref->{$category}}, $entry;
        }
    }

    $hash_ref;
}

sub parse_desktop_files {
    my ($self) = @_;
    my %categories;
    $self->parse(\%categories, $self->get_desktop_files);
    wantarray ? (%categories) : \%categories;
}

1;

__END__