#!/usr/bin/perl
#
# Copyright (C) 2010-2012 Trizen <echo dHJpemVueEBnbWFpbC5jb20K | base64 -d>.
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

# Author: Trizen
# License: GPLv3
# Created on:  07 July 2010, 12:00 PM
# Rewritten on: 16 February 2011
# Second rewrite on: 24 March 2012
# Latest edit on: 24 April 2012
# http://trizen.googlecode.com

eval 'exec perl -S $0 ${1+"$@"}'
  if 0;    # not running under some shell

use 5.010;
use strict;
use warnings;

# Autouse
use autouse 'Getopt::Std'      => qw(getopts);
use autouse 'URI::Escape'      => qw(uri_escape);
use autouse 'Text::ParseWords' => qw(quotewords);
use autouse 'JSON::XS'         => qw(decode_json);
use autouse 'File::Path'       => qw(make_path rmtree);
use autouse 'File::Basename'   => qw(basename dirname);

use File::Spec::Functions qw(catdir tmpdir curdir rel2abs);

my $pkgname  = q{Trizen's AUR Package Manager};
my $version  = '1.02';
my $execname = 'trizen';

# Configuration dir/file
my $config_dir = (
                  defined $ENV{XDG_CONFIG_HOME}
                  ? $ENV{XDG_CONFIG_HOME}
                  : ($ENV{HOME} || $ENV{LOGDIR} || (getpwuid $<)[7] || `echo -n ~`) . '/.config'
                 ) . "/$execname";

my $config_file = catdir($config_dir, "$execname.conf");
my $user = (getpwuid $<)[0] || substr(`whoami`, 0, -1);

if (not -d $config_dir) {
    make_path($config_dir) or warn "[!] Unable to create dir $config_dir: $!";
}

#----------------------- GLOBAL VARIABLES -----------------------#
$ENV{EDITOR} ||= 'nano';

my %CONFIG = (
              VERSION            => $version,
              show_comments      => 0,
              quiet              => 0,
              debug              => 0,
              nocolors           => 0,
              movepkg            => 0,
              noedit             => 0,
              skipinteg          => 0,
              overwrite          => 1,
              force              => 1,
              lwp_show_progress  => 0,
              lwp_keep_alive     => 1,
              lwp_env_proxy      => 1,
              packages_in_stats  => 4,
              lwp_timeout        => 60,
              build_dir          => tmpdir(),
              use_sudo           => -e '/usr/bin/sudo' ? 1 : 0,
              su_command         => 'su -c',
              sudo_command       => 'sudo',
              makepkg_command    => 'makepkg --syncdeps --force --clean',
              aur_rpc_base_url   => 'http://aur.archlinux.org/rpc.php',
              aur_package_id_url => 'https://aur.archlinux.org/packages.php?ID=%s',
              aur_base_url       => 'http://aur.archlinux.org',
              movepkg_dir        => '/var/cache/pacman/pkg',
              pacman_local_dir   => '/var/lib/pacman/local',
              pacman_command     => 'pacman',
             );

my %lconfig = (
               %CONFIG,
               devel         => 0,
               needed        => 0,
               tarball_only  => 0,
               noconfirm     => 0,
               install_all   => 0,
               aur           => 0,
               really_quiet  => 0,
               noinstall     => 0,
               update_config => 0,
               show_ood      => 0,
               as_root       => $user eq 'root' ? 1 : 0,
               stats         => \&show_stats,
               help          => \&help,
               version       => \&version,
              );

if (-e $config_file and (-s _) > 1) {
    my $config = do $config_file or die "error in reading $config_file: $!";

    if (ref $config eq 'HASH') {
        while (my ($k, $v) = each %{$config}) {
            $lconfig{$k} = $v;
            $CONFIG{$k}  = $v;
        }
        $lconfig{update_config} = 1 if $config->{VERSION} ne $version;
        $CONFIG{VERSION} = $version;
    }
    else {
        warn "[!] Invalid config file! ", ($! || "Doesn't return a HASH ref!\n");
    }
}
else {
    say "** Saving configuration file" if $lconfig{debug};
    Config::save_hash(\%CONFIG, $config_file) or warn "Unable to create configuration file $config_file: $!";
}

$lconfig{cache_dir} = catdir($lconfig{build_dir}, "$execname-$user");

if (not -d $lconfig{cache_dir}) {
    make_path($lconfig{cache_dir}) or die "[x] Unable to create dir $lconfig{cache_dir}: $!";
}

my %categories = (
                  1  => 'none',
                  2  => 'daemons',
                  3  => 'devel',
                  4  => 'editors',
                  5  => 'emulators',
                  6  => 'games',
                  7  => 'gnome',
                  8  => 'i18n',
                  9  => 'kde',
                  19 => 'kernels',
                  10 => 'lib',
                  11 => 'modules',
                  12 => 'multimedia',
                  13 => 'network',
                  14 => 'office',
                  15 => 'science',
                  16 => 'system',
                  17 => 'x11',
                  18 => 'xfce',
                 );

my $short_arguments = 'CUNQRSGbcdefghiklmnopqrstuvwy';

my %parens;
@parens{'<', '(', '[', '{'} = ('>', ')', ']', '}');

my @tarball_formats = qw
  (
  .tar.gz .tgz .tar.xz .tar.bz2
  .tar.lzma .tar .gz .tar.lzo .tar.7z
  );

# Skip these packages
my %ignored_packages;
@ignored_packages{qw{ sh svn java-environment }} = ();

my %just_installed;
my $tar_suffixes = join('|', map { quotemeta } @tarball_formats);
my $pkg_suffix_re = qr/-[^-]+-\d+-\w+\.pkg(?:$tar_suffixes)\z/;

# Subroutine prototypes
sub install_package ($);

# Main quit
sub main_quit () {
    if ($lconfig{update_config}) {
        Config::save_hash(\%CONFIG, $config_file);
    }
    exit $?;
}

#----------------------- COLORS -----------------------#
my %c;
$c{cblack}  = "\e[40m";                # background black
$c{byellow} = "\e[1;33m";              # bold yellow
$c{bpurle}  = "\e[1;35m";              # bold purple
$c{bblue}   = "\e[1;34m";              # bold blue
$c{bold}    = "\e[1m";                 # bold terminal color
$c{bred}    = "\e[1;31m";              # bold red
$c{bgreen}  = "$c{cblack}\e[1;32m";    # bold green on black background
$c{reset}   = "\e[0m";                 # reset color

if ('--nocolors' ~~ \@ARGV) {
    %c = map { $_ => q{} } keys %c;
}

#----------------------- USAGE -----------------------#
sub help () {
    print <<"HELP";
\n========================= $c{bgreen}$pkgname$c{reset} =========================
                                                            by trizenx\@gmail.com
\n$c{bold}usage:$c{reset} $execname [option] [pkgname] [pkgname] [...]
\n$c{bgreen}Base Options:$c{reset}
    -S              : installs package
    -Ss             : searches for package
    -Si             : outputs info for package
    -Sm             : outputs the packages maintained by [...]
    -Sp             : outputs PKGBUILD only
    -Su             : upgrades installed packages
    -Sc             : clears the cache directory
    -C              : outputs AUR comments only
    -G              : download and extract AUR tarball only
    -R              : remove packages (see pacman -Rh)
    -Q              : for installed packages (see pacman -Qh)
    -U              : installs local packages from $lconfig{cache_dir} or CWD
\n$c{bgreen}Other options:$c{reset}
    --quiet         : be quiet
    --really_quiet  : be really quiet
    --force         : set --force argument for makepkg and pacman
    --nocolors      : no text colors
    --aur           : only AUR packages (for: -S, -Si, -Su, -Ss)
    --noinstall     : build package only, don't install it
    --movepkg       : move the built package to the pacman cache directory
    --needed        : don't reinstall up to date packages
    --noedit        : do not prompt to edit files
    --devel         : update devel packages during -Su
    --show_ood      : show out-of-date flagged packages during -Su
    --noconfirm     : do not prompt for any confirmation
    --skipinteg     : when using makepkg, skip the checksum
    --stats         : show some info about the installed packages
    --update_config : update configuration file before exit
    --movepkg_dir=s : move built packages in this directory (with --movepkg)
\n$c{bgreen}Main options:$c{reset}
    --debug         : to see what's going on
    --help          : print this message and exit
    --version       : print version and exit\n
$c{bred}**$c{reset} Each key config is a valid argument if is preceded by '--'
$c{bred}**$c{reset} Configuration file: $config_file
HELP
    main_quit();
}

@ARGV or help();

sub version () {
    say "$pkgname v$version";
    main_quit();
}

#----------------------- PARSING ARGUMENTS -----------------------#
sub parse_long_arguments (@) {
    Getopt::Long::GetOptionsFromArray(
        \@_,
        \%lconfig,
        map {
                defined $lconfig{$_} && $lconfig{$_} =~ /^[01]\z/ ? "$_!"
              : ref $lconfig{$_} ? $_
              : "$_=s"
          } keys %lconfig,
    );
}

my @left_over_arguments;
{
    my @long_arguments;
    foreach my $arg (@ARGV) {
        given ($arg) {
            when (/^--\w/) {
                if (exists $lconfig{substr $arg, 2}) {
                    say "** Valid long argument: $_" if $lconfig{debug};
                    push @long_arguments, $arg;
                }
                else {
                    my $negated = substr($arg, 2);
                    $negated =~ s/^no-?//;
                    if (exists $lconfig{$negated}) {
                        $lconfig{$negated} = $lconfig{$negated} ? 0 : 1;
                    }
                    elsif ($arg =~ /.=/) {
                        my ($argument, $value) = $arg =~ /^--(.*?)=(.*)/;
                        if (exists $lconfig{$argument}) {
                            $lconfig{$argument} = $value;
                        }
                        else {
                            continue;
                        }
                    }
                    else {
                        continue;
                    }
                }
            }
            default {
                push @left_over_arguments, $arg;
            }
        }
    }

    if (@long_arguments) {
        require Getopt::Long;
        Getopt::Long::Configure('no_ignore_case');
        parse_long_arguments(@long_arguments);
    }
}

sub parse_short_arguments () {
    getopts($short_arguments, \%lconfig);
}

{
    my @short_arguments = grep { /^-[$short_arguments]/ } @ARGV;
    if (@short_arguments) {
        local @ARGV = @short_arguments;
        parse_short_arguments();
    }
}

my @pacman_arguments;

# Makepkg
if ($lconfig{as_root}) {
    warn "$c{bred}\[!] You are running '${execname}' as root!$c{reset}\n" if $lconfig{S};
    $lconfig{makepkg_command} .= ' --asroot';
}

if ($lconfig{skipinteg}) {
    $lconfig{makepkg_command} .= ' --skipinteg';
}

# Pacman
if ($lconfig{needed}) {
    push @pacman_arguments, '--needed';
}

if ($lconfig{quiet} or $lconfig{q}) {
    push @pacman_arguments, '--quiet';
}

if ($lconfig{force}) {
    push @pacman_arguments, '--force';
}

if ($lconfig{noconfirm}) {
    $Term::UI::AUTOREPLY = 1;
    push @pacman_arguments, '--noconfirm';
    $lconfig{makepkg_command} .= ' --noconfirm';
}
else {
    $Term::UI::AUTOREPLY = 0;
}

# Others
if ($lconfig{q}) {
    $lconfig{quiet} = 1;
}

if ($lconfig{debug}) {
    $lconfig{lwp_show_progress} = 1;
}

if ($lconfig{really_quiet}) {
    close STDOUT;
    close STDERR;
}

if ($lconfig{nocolors}) {
    %c = map { $_ => q{} } keys %c;
}

if ($lconfig{h}) {
    help();
}

#----------------------- WORK AREA -----------------------#

# Run-time loaded modules
require Term::UI;
require Term::ReadLine;
require Archive::Tar;
require LWP::UserAgent;

# Initializing module objects
my $tar  = Archive::Tar->new();
my $term = Term::ReadLine->new("$pkgname $version");

my $lwp = LWP::UserAgent->new(
                              env_proxy     => $lconfig{lwp_env_proxy},
                              keep_alive    => $lconfig{lwp_keep_alive},
                              show_progress => $lconfig{lwp_show_progress},
                              timeout       => $lconfig{lwp_timeout},
                              agent         => "Mozilla/5.0 (CLI; $pkgname) $execname/$version",
                             );

sub get ($) {
    my $response = $lwp->get(shift);
    if ($response->is_success) {
        return $response->content;
    }
    return;
}

sub mirror ($$) {
    return $lwp->mirror(@_);
}

sub get_non_arguments_from_array (@) {
    return grep { chr ord ne '-' } @_;
}

sub get_comments ($) {
    my ($id) = @_;

    defined $id or return;
    $id =~ /^\d+\z/ or return;

    my $url = sprintf($lconfig{aur_package_id_url}, $id);
    $url =~ s/^https:/http:/;

    my $content = get($url) or return;

    require HTML::Entities;

    my @comments;
    while (
        $content =~ m{
        <div\b.*?>\s*<p\b.*?>\s*
        Comment[ ]by:\s*(.*?)[ ]                        # Comment by: user
        on\s+(\w+,[ ]\d+[ ]\w+[ ]\d+[ ]\d+:\d+).*?      # on Sun, 06 Nov 2011 23:42:50 +0000
        </p>\s*</div>
        (?:\s*<blockquote\b.*?>)?
        \s*<div>\s*(.*?)</div>                          # Comment
    }gsix
      ) {
        my $author  = $1;
        my $date    = $2;
        my $comment = $3;
        $comment =~ s{<.*?>}{}gs;
        $author  =~ s{<.*?>}{}gs;
        $comment = HTML::Entities::decode_entities($comment);
        unshift @comments, <<"EOC"
$c{cblack}$c{byellow}Comment by: $c{bgreen}$author$c{reset}$c{cblack}$c{byellow} on $date$c{reset}
$comment
EOC
    }
    return @comments;
}

sub execute_pacman_command (@) {
    my $login = shift;
    my $pacman_command = join(
        q{ },
        do {
            my %seen;
            grep { !$seen{$_}++ } map { quotemeta } $lconfig{pacman_command}, @pacman_arguments, @_;
          }
    );

    my $user_pacman_command =
        $login
      ? $lconfig{use_sudo}
          ? "$lconfig{sudo_command} $pacman_command"
          : qq{$lconfig{su_command} "$pacman_command"}
      : $pacman_command;

    say "** Pacman command: $pacman_command" if $lconfig{debug};
    {
        system $lconfig{as_root} ? $pacman_command : $user_pacman_command;
        if ($? and $login) {
            say "** Exit code: $?" if $lconfig{debug};
            $term->ask_yn(prompt => "=>> Try again?", default => 'n') and redo;
        }
    }
    return $? ? 0 : 1;
}

sub is_available_in_pacman_repo (@) {
    (@_ = grep { defined && /^\w/ } @_) || return;
    system "$lconfig{pacman_command} -Si @_ &> /dev/null";
    return $? ? 0 : 1;
}

sub package_is_installed ($) {
    my $pkg = quotemeta shift;

    opendir(my $dir_h, $lconfig{pacman_local_dir}) or return;

    while (defined(my $dir = readdir($dir_h))) {
        if ($dir =~ m{^$pkg-[^-]+-\d+\z}) {
            closedir $dir_h;
            return 1;
        }
    }

    closedir $dir_h;
    return;
}

sub versioncmp ($$) {

    # Code from Sort::Versions
    # http://search.cpan.org/~edavis/Sort-Versions-1.5/Versions.pm

    my (@A) = $_[0] =~ /([-.]|\d+|[^-.\d]+)/g;
    my (@B) = $_[1] =~ /([-.]|\d+|[^-.\d]+)/g;

    my ($A, $B);
    while (@A and @B) {
        $A = shift @A;
        $B = shift @B;

        if ($A eq q{-} and $B eq q{-}) {
            next;
        }
        elsif ($A eq q{-}) {
            return -1;
        }
        elsif ($B eq q{-}) {
            return 1;
        }
        elsif ($A eq q{.} and $B eq q{.}) {
            next;
        }
        elsif ($A eq q{.}) {
            return -1;
        }
        elsif ($B eq q{.}) {
            return 1;
        }
        elsif ($A =~ /^\d+$/ and $B =~ /^\d+$/) {
            if ($A =~ /^0/ or $B =~ /^0/) {
                return $A cmp $B if $A cmp $B;
            }
            else {
                return $A <=> $B if $A <=> $B;
            }
        }
        else {
            $A = uc $A;
            $B = uc $B;
            return $A cmp $B if $A cmp $B;
        }
    }
    return @A <=> @B;
}

sub array_ref_or_string (@) {
    my ($data) = @_;
    return ref $data eq 'ARRAY' ? grep { defined && $_ ne q{} } @{$data} : $data // 'None';
}

sub strip_space ($) {
    my ($string) = @_;
    defined $string or return q{};
    $string =~ s/^\s+//;
    return unpack 'A*', $string;
}

sub strip_version ($) {
    my ($version) = @_;
    $version =~ s/\s*(?:==?|[<>]=?).+//sg;
    return strip_space($version);
}

sub indent_array (@) {
    my $first = strip_space(shift);

    @_ or return $first;

    my $rest = join "\n", @_;
    $rest =~ s/^\s+//gm;
    $rest =~ s/^/\t\t /gm;

    return "$first\n$rest";
}

sub parse_quoted_words ($) {
    my ($value) = @_;

    defined $value or return q{};

    $value = strip_space($value);

    if ($value =~ /^\((.+)\)\z/s) {
        $value = $1;
        return [grep { defined && $_ ne q{} } quotewords(qr{\s+|(?-s:#.*)}, 0, $value)];
    }

    $value =~ s/["']\s*#.*//;
    $value !~ /["']/ && $value =~ s/\s*#.*//;
    $value =~ s/^['"]//;
    $value =~ s/['"]$//;
    return $value =~ /\w/ ? $value : 'None';
}

sub parse_pkgbuild ($) {
    ref $_[0] eq 'HASH' or return;

    -f -r -s 'PKGBUILD' or do { warn "[!] Invalid PKGBUILD: $!"; return };

    my $pkgbuild = do { local (@ARGV, $/) = 'PKGBUILD'; <> };

    $pkgbuild =~ s/^\s*#.*//gm;

    while (
        $pkgbuild =~ m{
        ^\s*            # at the beginning of line
        (\w+)           # capturing word key (e.g.: pkgname)
        \h*=\h*         # optional horizontal space around the '='
        (               # capturing value
             \(.*?\)            # multi line values // e.g.: key=('value1' \n 'value2')
            (?=                 # start of look-ahead
                \s*                  # there may be some space               //
                (?:\#(?-s:.*))?      # and an optional comment              // e.g.: key=('test'); # comm
                (?:[\n;]|\z)         # and a newline or end of the string  //
            )                   # end of look-ahead
                 |              # OR
             (?-s:.*)           # a single value (e.g.: 'value')
        )               # end of capture
    }smgx
      ) {
        my $key = $1;
        chomp(my $value = $2);
        $key = strip_space($key);

        if (
            $value =~ s/\$([{(]?)(.+?)(??{ exists $parens{$1} ? quotemeta($parens{$1}) : qr{\b} })/
                            $_[0]->{pkgbuild}{$2} || "\$$1$2" . ($parens{$1} || q{})
        /gsex
          ) {
            say "Replaced VALUE: $value" if $lconfig{debug};
        }

        $value =~ s/;+\z//;
        $_[0]->{pkgbuild}{$key} = parse_quoted_words($value);
    }

    return 1;
}

sub get_tgz_package ($$) {
    my ($url, $output) = @_;
    if ($lconfig{overwrite} or not -e $output or -z _) {
        mirror($url, $output) or return;
    }
    else {
        warn "[!] $output already exists. (use --overwrite to replace)\n";
    }
    return 1;
}

sub get_package_tarball ($$) {
    my ($pkg, $path) = @_;
    my $info = get_rpc_info($pkg);

    if (ref $info->{results} ne 'HASH') {
        warn "[!] Unbale to find $pkg in AUR!\n" if $lconfig{debug};
        return;
    }

    my $tgz_file = catdir($path, basename($info->{results}{URLPath}));
    my $url = "$lconfig{aur_base_url}$info->{results}{URLPath}";

    get_tgz_package($url, $tgz_file) or do { warn "[!] Unable to get the tarball for $pkg: $!"; return };

    my $dir_name = catdir(dirname($tgz_file), basename($tgz_file, @tarball_formats));
    chdir $path or do { warn "[!] Unable to chdir() to $path: $!"; return };

    if ($lconfig{overwrite} or not -e "$dir_name/PKGBUILD" or -z _) {
        extract_tarball($tgz_file) or do { warn "[!] Unable to extract tarball of $pkg: $!"; return };
    }

    if (-d $dir_name) {
        chdir $dir_name or do { warn "[!] Unable to chdir() to $dir_name: $!"; return };
    }

    return $info;
}

sub extract_tarball ($) {
    my ($tarball) = @_;
    $tar->read($tarball) or return;
    $tar->extract() or return;
    return 1;
}

sub get_rpc_info ($) {
    my $pkg = uri_escape(shift);
    return decode_json(get("$lconfig{aur_rpc_base_url}?type=info&arg=$pkg") or return);
}

sub absolute_deps ($) {

    return q{} if not defined $_[0] or $_[0] eq q{};

    # For something like: perl-{gtk2-{imageview,unique},xml-fast},mplayer
    # *Almost* the same as: return glob($string);
    my @chunks = grep { defined && $_ ne q{} } split(/([{}])|,/, shift);

    my (@output, @root);
    foreach my $i (0 .. $#chunks) {
        if (defined $chunks[$i + 1] and $chunks[$i + 1] eq '{') {
            push @root, $chunks[$i];
        }
        elsif ($chunks[$i] ne '{' and $chunks[$i] ne '}') {
            push @output, join(q{}, @root, $chunks[$i]);
        }
        if (defined $chunks[$i + 1] and $chunks[$i + 1] eq '}') {
            pop @root;
        }
    }

    return @output;
}

sub show_info ($) {
    my ($info) = @_;

    return if ref $info->{results} ne 'HASH';

    say map { sprintf $c{bold} . $_->[0], $c{reset} . $_->[1] }
      ["Name           : %s\n", "$c{bold}$info->{results}{Name}$c{reset}"],
      ["Version        : %s\n", $info->{results}{Version} // 'Unknown'],
      ["Maintainer     : %s\n", $info->{results}{Maintainer} // "$c{bred}None$c{reset}"],
      ["Category       : %s\n", ucfirst $categories{$info->{results}{CategoryID}}],
      ["URL            : %s\n", indent_array(array_ref_or_string($info->{pkgbuild}{url}))],
      ["AUR URL        : %s\n", sprintf($lconfig{aur_package_id_url}, $info->{results}{ID})],
      ["Licenses       : %s\n", indent_array(array_ref_or_string($info->{pkgbuild}{license}))],
      ["Votes          : %s\n", $info->{results}{NumVotes}],
      ["Installed      : %s\n", package_is_installed($info->{results}{Name}) ? 'Yes' : 'No'],
      ["Out Of Date    : %s\n", $info->{results}{OutOfDate} ? "$c{bred}Yes$c{reset}" : 'No'],
      ["Groups         : %s\n", indent_array(array_ref_or_string($info->{pkgbuild}{groups}))],
      ["Provides       : %s\n", indent_array(array_ref_or_string($info->{pkgbuild}{provides}))],
      ["Depends On     : %s\n", indent_array(map { absolute_deps($_) } array_ref_or_string($info->{pkgbuild}{depends}))],
      ["Make Deps      : %s\n", indent_array(map { absolute_deps($_) } array_ref_or_string($info->{pkgbuild}{makedepends}))],
      ["Optional Deps  : %s\n", indent_array(array_ref_or_string($info->{pkgbuild}{optdepends}))],
      ["Conflicts With : %s\n", indent_array(array_ref_or_string($info->{pkgbuild}{conflicts}))],
      ["Replaces       : %s\n", indent_array(array_ref_or_string($info->{pkgbuild}{replaces}))],
      ["Architecture   : %s\n", indent_array(array_ref_or_string($info->{pkgbuild}{arch}))],
      ["Last Update    : %s\n", scalar localtime($info->{results}{LastModified} || $info->{results}{FirstSubmitted})],
      ["Description    : %s\n", array_ref_or_string($info->{pkgbuild}{pkgdesc})];

    return 1;
}

sub find_local_package ($$) {
    my ($pkg, $dir) = @_;

    my $newest_package;

    opendir(my $dir_h, $dir)
      or do { warn "[!] Unable to open dir $dir: $!"; return };

    while (defined(my $file = readdir $dir_h)) {
        if ($file =~ m{^\Q$pkg\E$pkg_suffix_re}) {

            # When exists more than one packages built,
            # get the newest version available
            if (defined $newest_package) {
                my ($new_version) = $file           =~ /($pkg_suffix_re)/;
                my ($old_version) = $newest_package =~ /($pkg_suffix_re)/;
                $newest_package = "$dir/$file" if versioncmp($old_version, $new_version) == -1;
            }

            # When $newest_package is undefined,
            # assign the first package found
            else {
                $newest_package = "$dir/$file";
            }
        }
    }

    closedir $dir_h;
    return $newest_package if defined $newest_package;
    return;
}

sub base_package_name ($) {
    my $pkg = basename(shift);
    $pkg =~ s/$pkg_suffix_re//;
    return $pkg;
}

sub move_built_package ($) {
    my ($pkg) = @_;
    my $pkg_tarball = find_local_package($pkg, catdir($lconfig{cache_dir}, $pkg)) or return;

    if (not -d $lconfig{movepkg_dir}) {
        make_path($lconfig{movepkg_dir}) or warn "[!] Unable to create $lconfig{movepkg_dir}: $!";
    }
    if (-d $lconfig{movepkg_dir}) {
        if (-w _) {
            say "** Moving $pkg_tarball into $lconfig{movepkg_dir}" if $lconfig{debug};
            rename($pkg_tarball, catdir($lconfig{movepkg_dir}, basename($pkg_tarball)))
              or warn "[!] Unable to move $pkg into $lconfig{movepkg_dir}: $!";
        }
        elsif (-d _) {
            say "** Moving '${pkg_tarball}' into '$lconfig{movepkg_dir}'";
            system $lconfig{use_sudo}
              ? "$lconfig{sudo_command} mv '${pkg_tarball}' '$lconfig{movepkg_dir}'"
              : qq{$lconfig{su_command} 'mv \Q$pkg_tarball\E $lconfig{movepkg_dir}'};
            $? and warn "error: 'mv' command exited with code: $?\n";
        }
    }
}

sub install_local_package (@) {
    my ($pkg, @pacman_argvs) = @_;

    my $pkg_tarball = find_local_package($pkg, catdir($lconfig{cache_dir}, $pkg))
      or do { warn "[!] Unable to find the built tarball for $pkg\n"; return };

    if (execute_pacman_command(1, $pkg_tarball, @pacman_argvs)) {
        if ($lconfig{movepkg}) {
            move_built_package($pkg);
        }
        return 1;
    }

    return;
}

sub output_file_content ($) {
    my ($file) = @_;

    open my $fh, '<', $file or do { warn "[!] Unable to open $file for read: $!"; return };
    say "\n=>> Content of $file:";
    while (defined(my $line = <$fh>)) {
        print $line;
    }
    close $fh;

    return 1;
}

sub edit_text_files () {
    foreach my $file (grep { -T and not -z _ } glob('*')) {

        next if substr($file, -1) eq q{~};       # ignore backup (~) files
        next if substr($file, -4) eq q{.bak};    # ignore backup (.bak) files
        next if chr ord $file eq q{.};           # ignore hidden files

        next
          if (-s $file) > 50 * 1024
          and not $file ~~ ['PKGBUILD', qr/(?:^|\.)install\z/];    # ignore files larger than 50 KB

        output_file_content($file) or next;

        if ($term->ask_yn(prompt => "=>> Do you want to edit ${file}?", default => 'n')) {
            my $abs_file = rel2abs($file);
            system $ENV{EDITOR}, $abs_file;

            if ($?) {
                warn "[!] $ENV{EDITOR} exited with code: $?\n";
                return;
            }
        }
    }

    return 1;
}

sub run_makepkg_command ($) {
    my ($pkg) = @_;
    system $lconfig{makepkg_command};
    if ($?) {
        warn "[!] Unable to build '$pkg' - makepkg exited with code: $?\n";
        if ($term->ask_yn(prompt => "=>> Do you want to try again?", default => 'n')) {
            install_package($pkg);
        }
        else {
            if ($term->ask_yn(prompt => "=>> Do you want to exit now?", default => 'y')) {
                exit 65;    # Package not installed
            }
        }
    }
    return 1;
}

sub install_local_tarball ($$) {
    my ($pkg, $argument) = @_;

    if (run_makepkg_command($pkg)) {
        if (not exists $just_installed{$pkg}) {
            $just_installed{$pkg} = 1;
            if ($lconfig{noinstall}) {
                move_built_package($pkg) if $lconfig{movepkg};
            }
            elsif (install_local_package($pkg, q{-U}, $argument)) {
                return 1;
            }
        }
        return 1;
    }

    return;
}

sub install_package ($) {
    my ($pkg) = @_;

    say "** Current dir is: ", rel2abs(curdir()) if $lconfig{debug};

    if (package_is_installed($pkg)) {
        say "** Package $pkg is already installed!" if $lconfig{debug};
        return 1 if $lconfig{needed};
    }

    my $info;
    if (ref($info = get_package_tarball($pkg, $lconfig{cache_dir})) eq 'HASH') {
        say "** Package $pkg is found in AUR!" if $lconfig{debug};
    }
    elsif (not $lconfig{aur} and is_available_in_pacman_repo($pkg)) {
        execute_pacman_command(1, qw(-S), $pkg) and return 1;
        return;
    }
    else {
        warn "[!] Unable to find package: $pkg\n" if $lconfig{debug};
        return;
    }

    ref $info->{results} eq 'HASH' or return;

    say "\n$c{bold}** Installing:$c{reset}: $c{bgreen}$info->{results}{Name}$c{reset}";
    say "$c{bold}** AUR URL:$c{reset} ", sprintf($lconfig{aur_package_id_url}, $info->{results}{ID});

    if ($lconfig{show_comments}) {
        foreach my $comment (get_comments($info->{results}{ID})) {
            say $comment;
        }
    }

    edit_text_files() if not $lconfig{noedit};    # edit PKGBUILD and other -T files
    parse_pkgbuild($info) or return;

    print "\n";
    show_info($info) or return;

    if (ref $info->{pkgbuild}{depends} eq 'ARRAY') {

        foreach my $dep (
            grep { defined && /^\w/ }
            map  { strip_version($_) }
            map  { absolute_deps($_) }

            # Makedepends
            ref $info->{pkgbuild}{makedepends} eq 'ARRAY'
            ? @{$info->{pkgbuild}{makedepends}}
            : $info->{pkgbuild}{makedepends},

            # Depends
            ref $info->{pkgbuild}{depends} eq 'ARRAY'
            ? @{$info->{pkgbuild}{depends}}
            : $info->{pkgbuild}{depends}
          ) {

            if (exists $ignored_packages{$dep}) {    # next if $dep exists in %ignored_packages
                say "** Ignored package: $dep" if $lconfig{debug};
                next;
            }

            if (not $lconfig{install_all} and package_is_installed($dep)) {
                say "** Skipping package $dep - already installed!" if $lconfig{debug};
            }
            elsif (is_available_in_pacman_repo($dep)) {
                say "** Package $dep is available in pacman's repository!" if $lconfig{debug};
            }
            else {
                say "** Trying to install package: $dep" if $lconfig{debug};
                install_package($dep) or do { warn "[!] Unable to install: $dep\n"; next };
            }
        }
    }

    chdir catdir($lconfig{cache_dir}, $pkg);
    say "** Current dir is: ", rel2abs(curdir()) if $lconfig{debug};

    if (defined $lconfig{main_pkg} and $pkg eq $lconfig{main_pkg}) {    # install as explicit
        say "** Installing as explicit: $pkg" if $lconfig{debug};
        install_local_tarball($pkg, '--asexplicit') and return 1;
    }
    else {                                                              # install as dependency
        say "** Installing as dependency: $pkg" if $lconfig{debug};
        install_local_tarball($pkg, '--asdep') and return 1;
    }

    return;
}

sub clean_cache () {
    say "** Removing $lconfig{cache_dir}";
    rmtree($lconfig{cache_dir}) or die "error: $!";
    say "** Done!";
    main_quit();
}

sub print_aur_results (\@) {
    my ($array_ref) = @_;
    foreach my $result (sort { $a->{Name} cmp $b->{Name} } @{$array_ref}) {
        if ($lconfig{quiet}) {
            say $result->{Name};
        }
        else {
            printf "$c{bold}%s$c{reset} %s %s%s[$c{bold}%s+$c{reset}] [%s] [%s] - %s\n", $result->{Name}, $result->{Version},
              ($result->{OutOfDate} ? "[$c{bred}out-of-date$c{reset}] " : q{}),
              ($result->{Maintainer} ? q{} : "[$c{bred}UNMAINTAINED$c{reset}] "),
              $result->{NumVotes}, $categories{$result->{CategoryID}},
              do { localtime($result->{LastModified}) =~ /^\w+ (\w+)\s+(\d+)\s+.+? (\d+)$/ && "$2 $1 $3" },
              $result->{Description};
        }
    }
    return 1;
}

sub search_aur_packages (@) {
    my (@keys) = @_;

    if (not $lconfig{aur}) {
        execute_pacman_command(0, qw(-Ss), @keys);
    }

    my @all_results;
    foreach my $key (grep { length() > 1 } map { uri_escape($_) } @keys) {
        push @all_results, decode_json(get("$lconfig{aur_rpc_base_url}?type=search&arg=$key") or next);
    }

    my @keys_re = map { qr/\Q$_\E/i } @keys;
    my %seen;

    my @matched_results;
    foreach my $results (@all_results) {

        ref $results->{results} eq 'ARRAY' or next;

      LOOP_2: foreach my $result (@{$results->{results}}) {
            next if $seen{$result->{Name}}++;
            foreach my $key_re (@keys_re) {
                if (not $result->{Name} =~ $key_re and not $result->{Description} =~ $key_re) {
                    next LOOP_2;
                }
            }
            push @matched_results, $result;
        }
    }
    print_aur_results(@matched_results) or return;
    return 1;
}

sub list_aur_maintainer_packages ($) {
    my ($maintainer) = @_;
    my $results = decode_json(get("$lconfig{aur_rpc_base_url}?type=msearch&arg=$maintainer") or return);
    ref $results->{results} eq 'ARRAY' or return;
    my @maintainers_packages = @{$results->{results}};
    print_aur_results(@maintainers_packages) or return;
    return 1;
}

sub update_local_packages () {
    if (not $lconfig{aur}) {
        execute_pacman_command(1, qw(-Syu));
    }

    my %packages;
    open my $pipe_h, '-|', "$lconfig{pacman_command} -Qm";
    while (defined(my $line = <$pipe_h>)) {
        my ($package, $version) = split(' ', $line);
        $packages{$package} = $version;
    }
    close $pipe_h;

    my $info_request = join('&', map { "arg[]=$_" } sort keys %packages);
    defined $info_request or return;

    my $multiinfo = decode_json(
        get("$lconfig{aur_rpc_base_url}?type=multiinfo&$info_request")
          or do { warn "** Unable to get info for local packages\n"; return }
    );

    ref $multiinfo->{results} eq 'ARRAY' or return;

    my $i = 0;
    my %for_update;
    foreach my $hash_ref (@{$multiinfo->{results}}) {

        ref $hash_ref eq 'HASH' or next;

        my $pkgname = $hash_ref->{Name};
        my $version = $hash_ref->{Version};

        if ($lconfig{show_ood}) {
            say "$c{bgreen}$pkgname$c{reset} has been flagged out of date!" if $hash_ref->{OutOfDate};
        }

        if (versioncmp($packages{$pkgname}, $version) == -1 or ($lconfig{devel} and $version =~ /^\d{2,}-\d{1,2}\z/)) {
            $for_update{++$i} = $pkgname;
            $for_update{$pkgname} = $pkgname;
            printf("$c{bblue}%2s$c{reset}. $c{bold}%s$c{reset}: $c{bred}%s$c{reset} --> $c{bgreen}%s$c{reset}\n",
                   $i, $pkgname, $packages{$pkgname}, $version);
        }
        elsif ($version ne $packages{$pkgname}) {
            say "$c{bold}$pkgname$c{reset} has a different version in AUR!",
              " ($c{bred}$packages{$pkgname}$c{reset} --> $c{bgreen}$version$c{reset})"
              if $lconfig{debug};
        }
    }

    my @for_update;
    if (keys %for_update) {
        given ($term->readline("\n=>> Choose packages for upgrade (default: all)\n>$c{reset} ")) {
            when (['all', q{}]) {
                @for_update = sort map { $for_update{$_} } grep { /^\d{1,2}\z/ and $_ > 0 and $_ <= $i } keys %for_update;
            }
            default {
                @for_update = map { $for_update{$_} } grep { exists $for_update{$_} } split /[,\s]+/;
            }
        }
    }
    else {
        say "$c{bold}** No AUR updates found!$c{reset}";
    }

    foreach my $pkgname (@for_update) {
        $lconfig{main_pkg} = $pkgname;
        if (install_package($pkgname)) {
            say "** $pkgname has been upgraded!" if $lconfig{debug};
        }
        else {
            warn "$c{bold}$pkgname$c{reset} has *NOT* been upgraded!\n";
        }
    }

    return 1;
}

sub show_stats {
    opendir my $dir_h, $lconfig{pacman_local_dir}
      or die "$c{bred}\[x] Unable to open dir '$lconfig{pacman_local_dir}':$c{reset} $!";

    my @newest_built_packages = [q{}, 0];
    my @oldest_built_packages = [q{}, 'inf'];

    my @newest_installed_packages = [q{}, 0];
    my @oldest_installed_packages = [q{}, 'inf'];

    my ($total_size, $num_of_pkgs, %dependencies, %reason_deps);
    while (defined(my $subdir = readdir $dir_h)) {

        next if $subdir eq q{.} or $subdir eq q{..};
        -d "$lconfig{pacman_local_dir}/$subdir" or next;

        ++$num_of_pkgs;
        my ($current_pkg) = $subdir =~ /^(.+?)-[^-]+-[^-]+$/;

        open my $fh, '<', "$lconfig{pacman_local_dir}/$subdir/desc" or next;
        while (defined(my $line = <$fh>)) {
            given ($line) {
                when ("%REASON%\n") {
                    $reason_deps{$current_pkg} = ();
                }
                when ("%DEPENDS%\n") {
                    while (defined(my $dep = <$fh>)) {
                        chomp $dep;
                        last if $dep eq q{};
                        $dependencies{strip_version($dep)} = ();
                    }
                }
                when ($_ eq "%PROVIDES%\n" and exists $reason_deps{$current_pkg}) {
                    while (defined(my $provided = <$fh>)) {
                        chomp $provided;
                        last if $provided eq q{};
                        push @{$reason_deps{$current_pkg}}, strip_version($provided);
                    }
                }
                when ("%SIZE%\n") {
                    $total_size += <$fh>;
                }
                when ("%BUILDDATE%\n") {
                    chomp(my $date = <$fh>);
                    if ($date < $oldest_built_packages[-1][1]) {
                        unshift @oldest_built_packages, [$current_pkg, $date];
                        @oldest_built_packages = sort { $a->[1] <=> $b->[1] } @oldest_built_packages;
                        pop @oldest_built_packages if @oldest_built_packages > $lconfig{packages_in_stats};
                    }
                    if ($date > $newest_built_packages[-1][1]) {
                        unshift @newest_built_packages, [$current_pkg, $date];
                        @newest_built_packages = sort { $b->[1] <=> $a->[1] } @newest_built_packages;
                        pop @newest_built_packages if @newest_built_packages > $lconfig{packages_in_stats};
                    }
                }
                when ("%INSTALLDATE%\n") {
                    chomp(my $date = <$fh>);
                    if ($date < $oldest_installed_packages[-1][1]) {
                        unshift @oldest_installed_packages, [$current_pkg, $date];
                        @oldest_installed_packages = sort { $a->[1] <=> $b->[1] } @oldest_installed_packages;
                        pop @oldest_installed_packages if @oldest_installed_packages > $lconfig{packages_in_stats};
                    }
                    if ($date > $newest_installed_packages[-1][1]) {
                        unshift @newest_installed_packages, [$current_pkg, $date];
                        @newest_installed_packages = sort { $b->[1] <=> $a->[1] } @newest_installed_packages;
                        pop @newest_installed_packages if @newest_installed_packages > $lconfig{packages_in_stats};
                    }
                }
            }
        }
    }
    closedir $dir_h;

    my $as_dep_packages = keys %reason_deps;

    print <<"STATS";
$c{bold}** Total installed packages:$c{byellow} $num_of_pkgs$c{reset}
$c{bold}** Explicitly installed packages:$c{byellow} ${\($num_of_pkgs - $as_dep_packages)}$c{reset}
$c{bold}** Asdep installed packages:$c{byellow} $as_dep_packages$c{reset}
$c{bold}** Theorical space used by packages:$c{byellow} ${\int $total_size / 1024**2} MB$c{reset}\n
$c{bold}** Oldest built packages:$c{byellow} @{[map { $_->[0] } @oldest_built_packages]}$c{reset}
$c{bold}** Newest built packages:$c{byellow} @{[map { $_->[0] } @newest_built_packages]}$c{reset}\n
$c{bold}** Oldest installed packages:$c{byellow} @{[map { $_->[0] } @oldest_installed_packages]}$c{reset}
$c{bold}** Newest installed packages:$c{byellow} @{[map { $_->[0] } @newest_installed_packages]}$c{reset}\n
STATS

    print "$c{bold}** Unneeded packages:$c{byellow}";
    while (my ($key, $value) = each %reason_deps) {
        next if exists $dependencies{$key};
        if (ref $value eq 'ARRAY') {
            next if grep { exists $dependencies{$_} } @{$value};
        }
        print qq{ $key};
    }
    say $c{reset};

    main_quit();
}

# MAIN

my @argv_packages = get_non_arguments_from_array(@left_over_arguments);

if ($lconfig{S}) {    # -S
    if ($lconfig{i}) {    # -Si
        foreach my $pkgname (@argv_packages) {
            !$lconfig{aur} && is_available_in_pacman_repo($pkgname)
              ? execute_pacman_command(0, qw(-Si), $pkgname)
              : (my $info = get_package_tarball($pkgname, $lconfig{cache_dir}));
            parse_pkgbuild($info) or next;
            show_info($info);
        }
    }
    elsif ($lconfig{u}) {    # -Su
        update_local_packages();
    }
    elsif ($lconfig{s}) {    # -Ss
        search_aur_packages(@argv_packages);
    }
    elsif ($lconfig{m}) {    # -Sm
        foreach my $maintainer (@argv_packages) {
            say "=>> ${maintainer}'s packages:" if $lconfig{debug};
            list_aur_maintainer_packages($maintainer) or do { say "None." if $lconfig{debug} };
        }
    }
    elsif ($lconfig{p}) {    # -Sp
        foreach my $pkgname (@argv_packages) {
            get_package_tarball($pkgname, $lconfig{cache_dir}) or next;
            open my $fh, '<', 'PKGBUILD' or do { warn "Unable to open PKGBUILD of $pkgname: $!"; next };
            say "$c{bold}=>> PKGBUILD of $c{cblack}$c{byellow}$pkgname$c{reset}:$c{reset}\n", <$fh>;
            close $fh;
        }
    }
    elsif ($lconfig{c}) {    # -Sc
        clean_cache();
    }
    else {                   # -S only
        if (@argv_packages) {
            foreach my $pkg (@argv_packages) {
                $lconfig{main_pkg} = $pkg;
                if (install_package($pkg)) {
                    say "** Package '$pkg' has been successfully installed!" if $lconfig{debug};
                }
                else {
                    warn "[!] Unable to install $pkg\n" if $lconfig{debug};
                }
            }
        }
    }
}
elsif ($lconfig{C}) {    # -C
    foreach my $pkg (@argv_packages) {
        my $info = get_rpc_info($pkg) or next;
        ref $info->{results} eq 'HASH' or next;
        say "$c{bold}** AUR comments for $c{bgreen}$pkg$c{reset}$c{bold}$c{reset}\n$c{bold}** URL:$c{reset} ",
          sprintf($lconfig{aur_package_id_url}, $info->{results}{ID}), "\n";
        foreach my $comment (get_comments($info->{results}{ID})) {
            say $comment;
        }
    }
}
elsif ($lconfig{G}) {    # -G
    foreach my $pkg (@argv_packages) {
        say "** Getting tarball of: $pkg" if $lconfig{debug};
        get_package_tarball($pkg, q{.}) or next;
        chdir q{..};
        unlink "$pkg.tar.gz" or warn "[!] Unable to delete './$pkg.tar.gz': $!";
    }
}
elsif ($lconfig{U}) {    # -U
    foreach my $pkg (@argv_packages) {
        if ($pkg =~ /$pkg_suffix_re/ and -e $pkg) {    # install from current dir
            execute_pacman_command(1, qw(-U), $pkg);
        }
        else {                                         # install from cache dir
            foreach my $dir (grep { -d } glob("$lconfig{cache_dir}/*")) {
                my $tarball = find_local_package($pkg, $dir) or next;
                say "$c{bold}** Installing:$c{reset} $tarball";
                execute_pacman_command(1, qw(-U), $tarball);
            }
        }
    }
}
elsif ($lconfig{R}) {                                  # -R
    @pacman_arguments = ();
    execute_pacman_command(1, @ARGV);
}
elsif ($lconfig{Q}) {                                  # -Q
    @pacman_arguments = ();
    execute_pacman_command(0, grep { !/^--/ } @ARGV);
}

main_quit();

package Config;

sub _dump {
    require Data::Dumper;
    return Data::Dumper::Dumper(shift);
}

sub _sort_items {
    my ($data) = @_;
    my ($items) = $data =~ /\{(.+?)\s*\};?\s*\z/s;
    $items .= ',';
    $data = "#!/usr/bin/perl\n\nscalar {"
      . join(
             "\n",
             (
              sort { lc $a cmp lc $b }
                split(/\n/, $items, 0)
             )
            ) . "\n};\n";

    $data =~ s{=>\s*'(\d+)',\s*$}  {=> $1,}gm;
    $data =~ s{(.+?)\s*=>\s*(.+)}{
        sprintf '%s%*s', $1, 40 - length($1) + length($2), ' => ' . $2;
    }egm;
    return $data;
}

sub save_hash {
    my ($config, $file) = @_;
    ref $config eq 'HASH' or return;
    open my $fh, '>', $file or return;
    print {$fh} _sort_items(_dump($config));
    close $fh;
    return 1;
}

1;