File Coverage

blib/lib/Linux/DesktopFiles.pm

Criterion	Covered	Total	%
statement	71	113	62.8
branch	21	66	31.8
condition	7	31	22.5
subroutine	4	7	57.1
pod	5	5	100.0
total	108	222	48.6

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.26';

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

sub _make_case_insensitive {
    lc($_[0]) =~ tr/_a-z0-9/_/cr;
}

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(
              AudioVideo
              Development
              Education
              Game
              Graphics
              Network
              Office
              Science
              Settings
              System
              Utility
              Engineering
              Amusement
              Documentation
              Adult
              Core
              COSMIC
              GTK
              Qt
              Motif
              Java
              ConsoleOnly
              )
        ],

        subcategories => {
            AudioVideo => [
                qw(
                  Audio
                  AudioVideoEditing
                  DiscBurning
                  Midi
                  Mixer
                  Music
                  Player
                  Recorder
                  Sequencer
                  Tuner
                  TV
                  Video
                  )
            ],
            Development => [
                qw(
                  Building
                  Database
                  Debugger
                  GUIDesigner
                  IDE
                  Profiling
                  ProjectManagement
                  RevisionControl
                  Translation
                  WebDevelopment
                  )
            ],
            Education => [
                qw(
                  Art
                  ArtificialIntelligence
                  Astronomy
                  Biology
                  Chemistry
                  ComputerScience
                  Construction
                  DataVisualization
                  Economy
                  Electricity
                  Geography
                  Geology
                  Geoscience
                  History
                  Humanities
                  ImageProcessing
                  Music
                  Languages
                  Literature
                  Maps
                  Math
                  NumericalAnalysis
                  MedicalSoftware
                  ParallelComputing
                  Physics
                  Robotics
                  Spirituality
                  Sports
                  )
            ],
            Game => [
                qw(
                  ActionGame
                  AdventureGame
                  ArcadeGame
                  BoardGame
                  BlocksGame
                  CardGame
                  KidsGame
                  LogicGame
                  RolePlaying
                  Shooter
                  Simulation
                  SportsGame
                  StrategyGame
                  Emulation
                  )
            ],
            Graphics => [
                qw(
                  2DGraphics
                  VectorGraphics
                  RasterGraphics
                  3DGraphics
                  Scanning
                  Photography
                  Publishing
                  Viewer
                  ImageProcessing
                  )
            ],
            Network => [
                qw(
                  Email
                  Dialup
                  InstantMessaging
                  Chat
                  IRCClient
                  Feed
                  FileTransfer
                  HamRadio
                  News
                  P2P
                  RemoteAccess
                  Telephony
                  TelephonyTools
                  VideoConference
                  WebBrowser
                  WebDevelopment
                  Monitor
                  )
            ],
            Office => [
                qw(
                  Calendar
                  ContactManagement
                  Database
                  Dictionary
                  Chart
                  Email
                  Finance
                  FlowChart
                  PDA
                  ProjectManagement
                  Presentation
                  Spreadsheet
                  WordProcessor
                  Photography
                  Publishing
                  )
            ],
            Science => [
                qw(
                  Art
                  Construction
                  Languages
                  ArtificialIntelligence
                  Astronomy
                  Biology
                  Chemistry
                  ComputerScience
                  DataVisualization
                  Economy
                  Electricity
                  Geography
                  Geology
                  Geoscience
                  History
                  Humanities
                  ImageProcessing
                  Literature
                  Maps
                  Math
                  NumericalAnalysis
                  MedicalSoftware
                  Physics
                  Robotics
                  Spirituality
                  Sports
                  ParallelComputing
                  Electronics
                  )
            ],
            Settings => [
                qw(
                  DesktopSettings
                  HardwareSettings
                  Printing
                  PackageManager
                  Security
                  Accessibility
                  )
            ],
            System => [
                qw(
                  Emulator
                  FileManager
                  TerminalEmulator
                  Filesystem
                  Monitor
                  Security
                  )
            ],
            Utility => [
                qw(
                  TextTools
                  Archiving
                  FileTools
                  Accessibility
                  Calculator
                  Clock
                  TextEditor
                  )
            ],
            GTK => [
                qw(
                  GNOME
                  XFCE
                  )
            ],
            Qt => [
                qw(
                  KDE
                  DDE
                  )
            ],
        },

        %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;
    };

    {
        my @cats = @{$data{categories}};

        if ($data{case_insensitive_cats}) {
            @cats = map { _make_case_insensitive($_) } @cats;
        }

        @{$data{_categories}}{@cats} = ();
    }

    foreach my $subcat (keys %{$data{subcategories}}) {

        my @subcats = @{$data{subcategories}{$subcat}};

        if ($data{case_insensitive_cats}) {
            $subcat = _make_case_insensitive($subcat);
        }

        @{$data{_subcategories}{$subcat}}{@subcats} = ();
    }

    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
    my @file_categories    = split(/;/, $info{Categories} // '');
    my @file_subcategories = @file_categories;

    if ($self->{case_insensitive_cats}) {
        @file_categories = map { _make_case_insensitive($_) } @file_categories;
    }

    my @cats = grep { exists($self->{_categories}{$_}) } @file_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;

    # Add subcategories
    my %subcategories;

    foreach my $cat (@file_categories) {
        if (exists $self->{_subcategories}{$cat}) {
            push @{$subcategories{$cat}}, grep { exists $self->{_subcategories}{$cat}{$_} } @file_subcategories;
        }
    }

    $info{SubCategories} = \%subcategories;

    # 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__