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.010;
#use strict;
#use warnings;

our $VERSION = '0.07';

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

    my $self = bless {}, $class;

    $self->{home_dir} = delete($opts{home_dir}) || $ENV{HOME} || $ENV{LOGDIR};

    my @default_arguments = qw(
      full_icon_paths
      icon_db_filename
      with_icons
      keep_empty_categories
      categories_case_sensitive
      skip_file_name_re
      skip_app_name_re
      skip_app_command_re
      skip_file_content_re
      clean_command_name_re
      skip_svg_icons
      icon_dirs_first
      icon_dirs_second
      icon_dirs_last
      use_only_my_icon_dirs
      terminalize
      use_current_theme_icons
      );

    @{$self}{@default_arguments} = delete @opts{@default_arguments};

    $self->{desktop_files_paths} =
        ref $opts{desktop_files_paths} eq 'ARRAY' ? delete($opts{desktop_files_paths})
      : defined($opts{desktop_files_paths})       ? [delete($opts{desktop_files_paths})]
      :                                             [qw(/usr/share/applications)];

    my $default_categories = {
                              utility     => undef,
                              development => undef,
                              education   => undef,
                              game        => undef,
                              graphics    => undef,
                              audiovideo  => undef,
                              network     => undef,
                              office      => undef,
                              settings    => undef,
                              system      => undef,
                             };

    $self->{keys_to_keep} =
        ref $opts{keys_to_keep} eq 'ARRAY' ? delete($opts{keys_to_keep})
      : defined($opts{keys_to_keep})       ? [delete($opts{keys_to_keep})]
      : [qw(Exec Name), $self->{with_icons} ? qw(Icon) : ()];

    $self->{file_keys_re} = do {
        my @keys = map quotemeta, do {
            my %seen;
            grep !$seen{$_}++, @{$self->{keys_to_keep}}, qw(Hidden NoDisplay Categories),
              $self->{terminalize} ? qw(Terminal) : ();
        };
        local $" = q{|};
        qr/@keys/;
    };

    $self->{categories} =
        ref $opts{categories} eq 'ARRAY' ? {map { $_ => undef } @{delete($opts{categories})}}
      : defined $opts{categories} ? {delete($opts{categories}) => 1}
      :                             $default_categories;

    $self->{true_value} =
        ref $opts{true_value} eq 'ARRAY' ? {map { $_ => 1 } @{delete($opts{true_value})}}
      : defined $opts{true_value} ? {delete($opts{true_value}) => 1}
      : {
         true => 1,
         True => 1,
         1    => 1
        };

    # Normalize categories
    if (not $self->{categories_case_sensitive}) {
        foreach my $key (keys %{$self->{categories}}) {
            my $category = lc $key;
            $category =~ tr/_a-z/_/c;
            $self->{categories}{$category} = delete($self->{categories}{$key});
        }
    }

    $self->{gtk_rc_filename} = delete($opts{gtk_rc_filename}) // "$self->{home_dir}/.gtkrc-2.0";
    $self->{terminal} = delete($opts{terminal}) || $ENV{TERM};

    if (defined $self->{icon_db_filename} and $self->{with_icons} and $self->{full_icon_paths}) {
        $self->init_icon_database() || warn "Can't open/create database '$self->{icon_db_filename}': $!";
    }

    foreach my $key (keys %opts) {
        warn "$0: Invalid option: $key\n";
    }

    return $self;
}

sub iterate_desktop_files {
    my ($self, $code) = @_;

    foreach my $dir (@{$self->{desktop_files_paths}}) {
        opendir(my $dir_h, $dir) or next;
        foreach my $file (readdir $dir_h) {
            $self->$code("$dir/$file") if substr($file, -8) eq '.desktop';
        }
        closedir $dir_h;
    }
}

sub get_desktop_files {
    my ($self) = @_;
    $self->iterate_desktop_files(sub { push @{$self->{DESKTOP_FILES}}, $_[1] });
    wantarray ? @{$self->{DESKTOP_FILES}} : $self->{DESKTOP_FILES};
}

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

    if (-r $self->{gtk_rc_filename}) {
        if (sysopen my $fh, $self->{gtk_rc_filename}, 0) {
            my $content;
            sysread $fh, $content, -s _;
            if ($content =~ /^\s*gtk-icon-theme-name\s*=\s*["']?([^'"\r\n]+)/im) {
                $self->{icon_theme} = $1;
            }
            close $fh;
        }
    }
    $self->{icon_theme} //= '';
}

sub get_icon_path {
    my ($self, $icon_name) = @_;

    if (defined($icon_name) and $icon_name ne q{}) {
        if (chr ord $icon_name eq '/') {
            return $icon_name if -f $icon_name;
        }
        else {
            $icon_name =~ s/\.\w{3}$//;
            return $icon_name unless $self->{full_icon_paths};
        }
    }
    else {
        return q{};
    }

    my $icon = $self->{icons_db}{$icon_name};

    if (not defined $icon) {

        if (not defined $self->{icon_theme}) {
            $self->get_icon_theme_name() if (!$self->{use_only_my_icon_dirs} || $self->{use_current_theme_icons});
        }

        my @icon_dirs;
        if (defined $self->{icon_dirs_first}
            and ref $self->{icon_dirs_first} eq 'ARRAY') {
            push @icon_dirs, grep -d, @{$self->{icon_dirs_first}};
        }

        if (length $self->{icon_theme} and (!$self->{use_only_my_icon_dirs} || $self->{use_current_theme_icons})) {
            my @icon_theme_dirs = (
                                   "/usr/share/icons/$self->{icon_theme}",
                                   "$self->{home_dir}/.icons/$self->{icon_theme}",
                                   "$self->{home_dir}/.local/share/icons/$self->{icon_theme}"
                                  );

            while (@icon_theme_dirs) {
                my $icon_dir = shift @icon_theme_dirs;

                if (-d $icon_dir) {
                    push @icon_dirs, $icon_dir if -d $icon_dir;
                    if (-e (my $index_theme = "$icon_dir/index.theme")) {

                        local $/ = "";
                        open my $fh, '<', $index_theme or next;

                        while (defined(my $para = <$fh>)) {
                            if ($para =~ /^\[Icon Theme\]/) {
                                if ($para =~ /^Inherits=(\S+)/m) {
                                    my $base = substr($icon_dir, 0, rindex($icon_dir, '/'));
                                    push @icon_theme_dirs, map { "$base/$_" } split(/,/, $1);
                                }
                                last;
                            }
                        }

                        close $fh;
                    }
                }
            }
        }

        if (defined $self->{icon_dirs_second}
            and ref $self->{icon_dirs_second} eq 'ARRAY') {
            push @icon_dirs, grep -d, @{$self->{icon_dirs_second}};
        }

        if (not $self->{use_only_my_icon_dirs}) {
            push @icon_dirs, grep -d,
              '/usr/share/pixmaps',                   '/usr/share/icons/hicolor',
              "$self->{home_dir}/.local/share/icons", "$self->{home_dir}/.icons";
        }

        if (defined $self->{icon_dirs_last}
            and ref $self->{icon_dirs_last} eq 'ARRAY') {
            push @icon_dirs, grep -d, @{$self->{icon_dirs_last}};
        }

        if (
            (
             my @uniq_dirs = (
                              do { my %seen; grep !$seen{$_}++ => @icon_dirs }
                             )
            )
          ) {
            require File::Find;
            File::Find::find(
                {
                 wanted => sub {
                     return if substr($File::Find::name, -4, 1) ne q{.};
                     return if substr($_, -4, 4, q{}) eq '.svg' and $self->{skip_svg_icons};
                     return if exists $self->{icons_db}{$_};
                     $self->{icons_db}{$_} = $File::Find::name;
                 },
                } => @uniq_dirs
            );
        }

    }

    unless (defined $icon) {
        $icon = $self->{icons_db}{$icon_name};
        unless (defined $icon) {
            $self->{icons_db}{$icon_name} = '';
            $icon = '';
        }
    }

    $icon;    # return the icon
}

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

    $self->_clean_categories();
    $self->_store_info(-f $file ? $file : return);

    foreach my $value (values %{$self->{categories}}) {
        return $value->[0] if ref $value eq 'ARRAY';
    }

    return;
}

sub _store_info {
    my $self = shift;

    foreach my $desktop_file (@_) {

        if (defined $self->{skip_file_name_re}) {
            next if substr($desktop_file, rindex($desktop_file, '/') + 1) =~ /$self->{skip_file_name_re}/o;
        }

        my $file;
        sysopen my $desktop_fh, $desktop_file, 0 or next;
        sysread $desktop_fh, $file, -s $desktop_file;

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

        my %info = $file =~ m{^($self->{file_keys_re})=(.*\S)\s*$}gm;

        if (defined $info{NoDisplay}) {
            next if exists $self->{true_value}{$info{NoDisplay}};
        }

        if (defined $info{Hidden}) {
            next if exists $self->{true_value}{$info{Hidden}};
        }

        my @categories = split(/;/, $info{Categories} // next);

        my $found_cat = 0;
        foreach my $category (@categories) {
            if (not $self->{categories_case_sensitive}) {
                $category = lc $category;
                $category =~ tr/_a-z/_/c;
            }
            elsif ($found_cat) {
                last;
            }
            ++$found_cat if not $found_cat and exists $self->{categories}{$category};
        }
        next if not $found_cat;

        if (defined $self->{skip_file_content_re}) {
            next if $file =~ /$self->{skip_file_content_re}/o;
        }

        if (defined $self->{clean_command_name_re}) {
            $info{Exec} =~ s/$self->{clean_command_name_re}//go;
        }

        if (defined $self->{skip_app_command_re}) {
            next if $info{Exec} =~ /$self->{skip_app_command_re}/o;
        }

        $info{Exec} =~ s/ +%.*//s if index($info{Exec}, q{ %}) != -1;

        if (defined $self->{skip_app_name_re}) {
            next if $info{Name} =~ /$self->{skip_app_name_re}/o;
        }

        if (    $self->{terminalize}
            and defined $info{Terminal}
            and exists $self->{true_value}{$info{Terminal}}) {
            $info{Exec} = qq[$self->{terminal} -e '$info{Exec}'];
        }

        if ($self->{with_icons}) {
            $info{Icon} = $self->get_icon_path($info{Icon});
        }

        foreach my $category (@categories) {
            next unless exists $self->{categories}{$category};
            push @{$self->{categories}{$category}}, {map { $_ => $info{$_} } @{$self->{keys_to_keep}}};
        }
    }
    1;
}

sub _clean_categories {
    my ($self) = @_;
    @{$self->{categories}}{keys %{$self->{categories}}} = ();
}

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

    return $self->{keep_empty_categories}
      ? {%{$self->{categories}}}
      : {
         map { $_ => $self->{categories}{$_} }
         grep ref $self->{categories}{$_} eq 'ARRAY', keys %{$self->{categories}}
        };
}

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

    $self->_clean_categories();
    $self->iterate_desktop_files(\&_store_info);
    return $self->get_categories();
}

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

    require GDBM_File;
    GDBM_File->import;
    tie %{$self->{icons_db}}, 'GDBM_File', $self->{icon_db_filename}, &GDBM_WRCREAT, 0640;
}

1;

__END__

=head1 NAME

Linux::DesktopFiles - Get and parse the Linux .desktop files.

=head1 SYNOPSIS

  use Linux::DesktopFiles;
  my $obj = Linux::DesktopFiles->new( terminalize => 1 );
  print join "\n", $obj->get_desktop_files;
  my $hash_ref = $obj->parse_desktop_files;

=head1 DESCRIPTION

The C<Linux::DesktopFiles> is a very simple module to parse .desktop files.

=head1 CONSTRUCTOR METHODS

The following constructor methods are available:

=over 4

=item $obj = Linux::DesktopFiles->new( %options )

This method constructs a new C<Linux::DesktopFiles> object and returns it.
Key/value pair arguments may be provided to set up the initial state.
The following options correspond to attribute methods described below:

   KEY                         DEFAULT
   -----------                 --------------------
   with_icons                  0
   full_icon_paths             0
   skip_svg_icons              0
   icon_db_filename            undef
   icon_dirs_first             undef
   icon_dirs_second            undef
   icon_dirs_last              undef

   categories_case_sensitive   0
   keep_empty_categories       0
   use_only_my_icon_dirs       0
   use_current_theme_icons     0/1
   terminalize                 0
   terminal                    $ENV{TERM}
   home_dir                    $ENV{HOME}
   gtk_rc_filename             "~/.gtkrc-2.0"
   true_value                  ['true', 'True', '1']

   skip_file_name_re           undef
   skip_app_name_re            undef
   skip_app_command_re         undef
   skip_file_content_re        undef
   clean_command_name_re       undef

   desktop_files_paths         ['/usr/share/applications']
   keys_to_keep                ["Name", "Exec"]
   categories                  [qw( utility
                                    development
                                    education
                                    game
                                    graphics
                                    audiovideo
                                    network
                                    office
                                    settings
                                    system )
                               ]

=back

=head2 Main options

=over 4

=item desktop_files_paths => ['dir1', 'dir2', ...]

Set directories where to find the .desktop files (default: /usr/share/applications)

=item keys_to_keep => [qw(Icon Exec Name Comment ...)]

Any of the valid keys from .desktop files. This keys will be stored in the retured
hash reference when calling C<$obj-E<gt>parse_desktop_files>.

=item categories => [qw(Graphics Network AudioVideo ...)]

Any of the valid categories from the .desktop files. Any category not listed,
will be ignored.

=back

=head2 Other options

=over 4

=item keep_empty_categories => 1

If a category is empty, keep it in the returned hash reference when
I<parse_desktop_files> is called.

=item categories_case_sensitive => 1

Make categories case sensitive. By default, they are case insensitive
in a way that "X-XFCE4" is equivalent to "x_xfce4".

=item terminalize => 1

When B<Terminal> is true, modify the B<Exec> value to something like:
I<terminal -e 'command'>

=item terminal => "xterm"

This terminal will be used when I<terminalize> is set to a true value.

=item home_dir => "/home/dir"

Set the home directory. This value is used to locate icons in the ~/.local/share/icons.

=item gtk_rc_filename => "/path/to/.gtkrc-x.x"

This file is used to get the icon theme name from it. (default: ~/.gtkrc-2.0)
I<NOTE:> It works with Gtk3 as well.

=item true_value => [qw(1 true True)]

This values are used to test for I<true> some values from the .desktop files.

=back

=head2 Icon options

=over 4

=item with_icons => 1

Require icons. Unless I<full_icon_paths> is set to a true value, this
option will return icon names without the extension. If an B<Icon> value
is an absolute path to an icon in the system, it will be returned as it is.

=item full_icon_paths => 1

Full icon paths for B<Icon> values.

=item icon_db_filename => "filename.db"

GDBM database name used to store icon names as keys and icon paths as
values for a faster lookup (used with GDBM_File).
I<NOTE:> Works in combination with B<full_icon_paths> and B<with_icons>

=item skip_svg_icons => 1

Ignore .svg icons when looking for full icon paths.

=item icon_dirs_first => [dir1, dir2, ...]

When looking for full icon paths, look in this directories first, before
looking in the directories of the current icon theme.

=item icon_dirs_second => [dir1, dir2, ...]

When looking for full icon paths, look in this directories as a second
icon theme. (Before I</usr/share/pixmaps>)

=item icon_dirs_last => [dir1, dir2, ...]

Look in this directories at the very last, after looked in I</usr/share/pixmaps>,
I</usr/share/icons/hicolor> and some other directories.

=item use_only_my_icon_dirs => 1

Be very strict and use only the directories specified by you in either
one of I<icon_dirs_first>, I<icon_dirs_second> and/or I<icon_dirs_last>

=item use_current_theme_icons => 1

Use your current theme icons (from ~/.gtkrc-2.0), even when I<use_only_my_icon_dirs>
is set to a true value. This option is useful when you want to get only the icons
from the current theme. It is usually used in combination with I<use_only_my_icon_dirs>.
When I<use_only_my_icon_dirs> is set a false value, this option is true by default.
When I<use_only_my_icon_dirs> is set a true value, this option is false by default.

=back

=head2 Regex options

=over 4

=item skip_file_name_re => qr/regex/

Skip .desktop files if their file names will match the regex.
I<NOTE:> File names are from the last slash to the end.

=item skip_app_name_re => qr/regex/

Skip .desktop files based on the value of B<Name>.

=item skip_app_command_re => qr/regex/

Skip .desktop files based on the value of B<Exec>.

=item skip_file_content_re => qr/regex/

Skip .desktop files if the regex matches anywhere in the [Desktop Entry]
section.

=item clean_command_name_re =>  qr/regex/

Anything matched by this regex in the values of B<Exec> will be replaced
with nothing.

=back

=head1 SUBROUTINES/METHODS

=over 4

=item $obj->iterate_desktop_files(\&code_ref)

Iterate over desktop files, one file at a time.

=item $obj->get_desktop_files()

Get all desktop files. In list context it returns a list, but in scalar context,
it returns an array reference containing the full names of the desktop files.

=item $obj->get_icon_theme_name()

Returns the icon theme name, if any, otherwise it returns an empty string.

=item $obj->get_icon_path("icon_name")

If I<full_icon_paths> is set to a true value, it returns the absolute path of
a icon name located in the system. If it can't found the icon name, it returns
an empty string.
If I<full_icon_paths> is set to a false value, it strips the extension name of
the icon (if any), and returns the icon name. If the icon name is undefined, it
returns an empty string.

=item $obj->parse_desktop_file("filename")

It returns a HASH reference which contains the I<keys_to_keep> and the values
from the desktop file specified as an argument.

=item $obj->parse_desktop_files()

It returns a HASH reference which categories names as keys, and ARRAY references
as values which contains HASH references with the keys specified in the I<keys_to_keep>
option, and values from the .desktop files.

The returned HASH reference might look something like this:

        {
          utility => [ {Exec => "...", Name => "..."}, {Exec => "...", Name => "..."} ],
          network => [ {Exec => "...", Name => "..."}, {Exec => "...", Name => "..."} ],
        }

=back

=head1 AUTHOR

Suteu "Trizen" Daniel, E<lt>trizenx@gmail.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2012-2013

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.14.2 or,
at your option, any later version of Perl 5 you may have available.

=head1 SEE ALSO

L<File::DesktopEntry> and L<X11::FreeDesktop::DesktopEntry>

=cut
