#!/usr/bin/perl

use strict;
use warnings FATAL => 'all';
use v5.34.0; # The Perl version on Slackware 15.0 (sbozyp's min supported version)

package Sbozyp;

our $VERSION = '1.5.4';

use Cwd qw();
use Digest::MD5 qw();
use File::Basename qw(basename dirname);
use File::Temp qw();
use File::Path qw(make_path remove_tree);
use Getopt::Long qw(GetOptionsFromArray :config no_ignore_case no_bundling);
use Pod::Usage qw(pod2usage);

our %CONFIG = (
    # defaults
    TMPDIR => '/tmp',
    REPO_ROOT => '/var/lib/sbozyp/SBo',
    SRCDIR => '/var/lib/sbozyp/source-cache',
    #REPO_NAME => REPO_PRIMARY
);

# 'unless caller' allows us to load this file from test code without executing main()
unless (caller) { main(@ARGV); exit 0 }

sub main {
    my @argv = @_;
    # process global options
    Getopt::Long::Configure('pass_through'); # pass_through to ignore the command options
    sbozyp_getopts(
        \@argv,
        'C'   => \my $opt_clone,
        'F=s' => \(my $opt_configfile = '/etc/sbozyp/sbozyp.conf'),
        'R=s' => \my $opt_reponame,
        'S'   => \my $opt_syncrepo,
        'T'   => \my $opt_noinitrepo
    );
    Getopt::Long::Configure('nopass_through');
    # determine the command main function
    my $cmd = shift(@argv) or die command_usage('main');
    my $cmd_main;
    if    ($cmd =~ /^(?:--help|-h)$/)    { print command_help_msg('main'); return }
    elsif ($cmd =~ /^(?:--version|-V)$/) { print $VERSION, "\n"; return           }
    elsif ($cmd =~ /^(?:build|bu)$/)     { $cmd_main = \&main_build               }
    elsif ($cmd =~ /^(?:install|in)$/)   { $cmd_main = \&main_install             }
    elsif ($cmd =~ /^(?:null|nu)$/)      { $cmd_main = \&main_null                }
    elsif ($cmd =~ /^(?:query|qr)$/)     { $cmd_main = \&main_query               }
    elsif ($cmd =~ /^(?:remove|rm)$/)    { $cmd_main = \&main_remove              }
    elsif ($cmd =~ /^(?:search|se)$/)    { $cmd_main = \&main_search              }
    else                                 { sbozyp_die("invalid command '$cmd'")   }
    # set the configuration
    parse_config_file($opt_configfile); # mutates the global %CONFIG
    set_repo_name_or_die($opt_reponame // $CONFIG{REPO_PRIMARY});
    # initialize the environment
    return if $opt_noinitrepo and !repo_is_cloned();
    if ($opt_clone or !repo_is_cloned()) {
        i_am_root_or_die('need root to clone repo');
        clone_repo();
    }
    if ($opt_syncrepo) {
        i_am_root_or_die('need root to sync repo');
        sync_repo();
    }
    # run the command
    $cmd_main->(@argv);
}

            ####################################################
            #                     COMMANDS                     #
            ####################################################

sub main_install {
    sbozyp_getopts(
        \@_,
        'h|help' => \my $opt_help,
        'b=s'    => \(my $opt_blacklistfile = '/etc/sbozyp/sbozyp.blacklist'),
        'f'      => \my $opt_force,
        'k'      => \my $opt_keeppackage,
        'r'      => \my $opt_installdeps,
        'y'      => \my $opt_noninteractive,
        'z'      => \my $opt_keepsrc
    );
    if ($opt_help) { print command_help_msg('install'); return }
    @_ >= 1 or die command_usage('install');
    i_am_root_or_die('the install command requires root');
    my @pkgs = pkgs_uniq(map { $_ = pkg($_) } @_);
    my @queue; for my $pkg (@pkgs) {
        my @pkg_queue = $opt_installdeps ? pkg_queue($pkg) : ($pkg);
        unless ($opt_force) {
            @pkg_queue = do {
                my @_pkg_queue; for my $pkg (@pkg_queue) {
                    if (pkg_matches_blacklist($pkg, $opt_blacklistfile)) {
                        sbozyp_print_stderr("skipping $pkg->{PKGNAME} due to blacklist match\n");
                    } elsif (pkg_installed_and_up_to_date($pkg)) {
                        sbozyp_print_stderr("skipping $pkg->{PKGNAME} as it's installed and up to date\n");
                    } else {
                        push @_pkg_queue, $pkg;
                    }
                }
                @_pkg_queue
            };
        }
        @queue = pkgs_merged(@queue, @pkg_queue);
    }
    if (@queue) {
        if (not $opt_noninteractive) {
            sbozyp_print('are you sure you want to install these packages:', "\n");
            return unless pkgs_confirm_with_user(@queue);
        }
        for my $pkg (@queue) {
            my $slackware_pkg = built_slackware_pkg($pkg) // build_slackware_pkg($pkg, $opt_keepsrc);
            install_slackware_pkg($slackware_pkg);
            sbozyp_unlink($slackware_pkg) unless $opt_keeppackage;
        }
    } else {
        sbozyp_print('no packages to install', "\n");
    }
}

sub main_build {
    sbozyp_getopts(
        \@_,
        'h|help' => \my $opt_help,
        'f'      => \my $opt_force,
        'y'      => \my $opt_noninteractive,
        'z'      => \my $opt_keepsrc
    );
    if ($opt_help) { print command_help_msg('build'); return }
    @_ >= 1 or die command_usage('build');
    i_am_root_or_die('the build command requires root');
    my @pkgs = pkgs_uniq(map { $_ = pkg($_) } @_);
    if (not $opt_noninteractive) {
        sbozyp_print('are you sure you want to build these packages:', "\n");
        return unless pkgs_confirm_with_user(@pkgs);
    }
    for my $pkg (@pkgs) {
        if (my $slackware_pkg = built_slackware_pkg($pkg)) {
            unless ($opt_force) {
                sbozyp_print("existing package for $pkg->{PKGNAME} found at '$slackware_pkg'\n");
                next;
            }
        }
        build_slackware_pkg($pkg, $opt_keepsrc);
    }
}

sub main_remove {
    sbozyp_getopts(
        \@_,
        'h|help' => \my $opt_help,
        'f'      => \my $opt_nodepsafetycheck,
        'r'      => \my $opt_removedeps,
        'y'      => \my $opt_noninteractive
    );
    if ($opt_help) { print command_help_msg('remove'); return }
    @_ >= 1 or die command_usage('remove');
    i_am_root_or_die('the remove command requires root');
    my @pkgs = pkgs_uniq(map { $_ = pkg($_) } @_);
    unless ($opt_nodepsafetycheck) {
        my @errors; for my $pkg (@pkgs) {
            my @dependents = pkg_array_minus([pkg_dependents_direct($pkg)], [@pkgs]);
            if (@dependents) {
                my $error = sbozyp_error_prefix()."package $pkg->{PKGNAME} is depended on by:\n";
                $error .= "    $_->{PKGNAME}\n" for @dependents;
                push @errors, $error;
            }
        }
        die @errors if @errors;
    }
    @pkgs = (@pkgs, pkgs_removable_dependencies(@pkgs)) if $opt_removedeps;
    for my $pkg (@pkgs) {
        if (!defined pkg_installed($pkg)) {
            sbozyp_die("the package $pkg->{PKGNAME} is not installed");
        }
    }
    if (not $opt_noninteractive) {
        sbozyp_print('are you sure you want to remove these packages:', "\n");
        return unless pkgs_confirm_with_user(@pkgs);
    }
    remove_slackware_pkg($_->{PRGNAM}) for @pkgs;
}

sub main_query {
    sbozyp_getopts(
        \@_,
        'h|help' => \my $opt_help,
        'a'      => \my $opt_listinstalled,
        'b'      => \my $opt_printpackagedir,
        'c'      => \my $opt_printrepodir,
        'd'      => \my $opt_slackdesc,
        'i'      => \my $opt_info,
        'm'      => \my $opt_pkgsnodependents,
        'n'      => \my $opt_recdependents,
        'o'      => \my $opt_directdependents,
        'p'      => \my $opt_pkginstalled,
        'q'      => \my $opt_printqueue,
        'r'      => \my $opt_readme,
        's'      => \my $opt_slackbuild,
        'u'      => \my $opt_listneedupdate,
        'v'      => \my $opt_listneedupdateversion
    );
    if ($opt_help) { print command_help_msg('query'); return }
    if (@_ > 1) { die command_usage('query') }
    my $num_opts_set = 0; for ($opt_listinstalled,$opt_printpackagedir,$opt_printrepodir,$opt_slackdesc,$opt_info,$opt_pkgsnodependents,$opt_recdependents,$opt_directdependents,$opt_pkginstalled,$opt_printqueue,$opt_readme,$opt_slackbuild,$opt_listneedupdate,$opt_listneedupdateversion) { $num_opts_set++ if defined }
    if    ($num_opts_set != 1)  { sbozyp_die("must set exactly 1 query option but $num_opts_set were set") }
    my $opt = $opt_listinstalled ? '-a' : $opt_printpackagedir ? '-b' : $opt_printrepodir ? '-c' : $opt_slackdesc ? '-d' : $opt_info ? '-i' : $opt_pkgsnodependents ? '-m' : $opt_recdependents ? '-n' : $opt_directdependents ? '-o' : $opt_pkginstalled ? '-p' : $opt_printqueue ? '-q' : $opt_readme ? '-r' : $opt_slackbuild ? '-s' : $opt_listneedupdate ? '-u' : $opt_listneedupdateversion ? '-v' : die;
    my $pkg; if ($opt_printpackagedir || $opt_slackdesc || $opt_info || $opt_recdependents || $opt_directdependents || $opt_pkginstalled || $opt_printqueue || $opt_readme || $opt_slackbuild) {
        @_ == 1 or sbozyp_die("query option '$opt' requires single PKGNAME argument");
        $pkg = pkg($_[0]);
    } else {
        @_ == 0 or sbozyp_die("query option '$opt' does not take PKGNAME argument");
    }
    # option implementations
    if ($opt_listinstalled) {
        my %installed_sbo_pkgs = installed_sbo_pkgs();
        for my $pkgname (sort keys %installed_sbo_pkgs) {
            print $pkgname, "\n";
        }
    } elsif ($opt_printpackagedir) {
        print $pkg->{PKGDIR}, '/', "\n";
    } elsif ($opt_printrepodir) {
        print repo_dir(), "\n";
    } elsif ($opt_slackdesc) {
        sbozyp_print_file("$pkg->{PKGDIR}/slack-desc");
    } elsif ($opt_info) {
        sbozyp_print_file("$pkg->{PKGDIR}/$pkg->{PRGNAM}.info");
    } elsif ($opt_pkgsnodependents) {
        print "$_->{PKGNAME}\n" for pkgs_no_dependents();
    } elsif ($opt_recdependents) {
        print "$_->{PKGNAME}\n" for pkg_dependents_recursive($pkg);
    } elsif ($opt_directdependents) {
        print "$_->{PKGNAME}\n" for pkg_dependents_direct($pkg);
    } elsif ($opt_pkginstalled) {
        if (defined(my $version = pkg_installed($pkg))) {
            print "$version\n";
        }
    } elsif ($opt_printqueue) {
        print "$_->{PKGNAME}\n" for pkg_queue($pkg);
    } elsif ($opt_readme) {
        sbozyp_print_file("$pkg->{PKGDIR}/README");
    } elsif ($opt_slackbuild) {
        sbozyp_print_file("$pkg->{PKGDIR}/$pkg->{PRGNAM}.SlackBuild");
    } elsif ($opt_listneedupdate) {
        my %installed_sbo_pkgs = installed_sbo_pkgs();
        for my $pkgname (sort keys %installed_sbo_pkgs) {
            my $installed_version = $installed_sbo_pkgs{$pkgname};
            my $available_version = pkg($pkgname)->{VERSION};
            print $pkgname, "\n" if version_gt($available_version, $installed_version);
        }
    } elsif ($opt_listneedupdateversion) {
        my %installed_sbo_pkgs = installed_sbo_pkgs();
        for my $pkgname (sort keys %installed_sbo_pkgs) {
            my $installed_version = $installed_sbo_pkgs{$pkgname};
            my $available_version = pkg($pkgname)->{VERSION};
            if (version_gt($available_version, $installed_version)) {
                print "$pkgname $installed_version -> $available_version\n";
            }
        }
    }
}

sub main_search {
    sbozyp_getopts(
        \@_,
        'h|help' => \my $opt_help,
        'c'      => \my $opt_casesensitive,
        'n'      => \my $opt_matchcategory,
        'p'      => \my $opt_prgnam,
        'q'      => \my $opt_quiet
    );
    if ($opt_help) { print command_help_msg('search'); return }
    @_ == 1 or die command_usage('search');
    my $regex_arg = $_[0];
    my $regex = eval { $opt_casesensitive ? qr/$regex_arg/ : qr/$regex_arg/i };
    sbozyp_die("invalid Perl regex: $regex_arg") if $@;
    my @matches = grep {
        $opt_matchcategory ? $_ =~ $regex : basename($_) =~ $regex;
    } all_pkgnames();
    if (@matches) {
        if ($opt_prgnam) {
            @matches = sort map { $_ = basename($_) } @matches;
        }
        print $_, "\n" for @matches;
    } elsif (not $opt_quiet) {
        sbozyp_print('no matches found', "\n");
    }
}

sub main_null {
    sbozyp_getopts(
        \@_,
        'h|help' => \my $opt_help,
    );
    if ($opt_help) { print command_help_msg('null'); return }
    @_ == 0 or die command_usage('null');
}

            ####################################################
            #                 PACKAGE OPERATIONS               #
            ####################################################

sub pkg {
    my ($prgnam) = @_;
    my $pkgname = prgnam_to_pkgname($prgnam) // sbozyp_die("could not find a package named $prgnam");
    state %pkg_cache; if (my $pkg = $pkg_cache{$pkgname}) { return $pkg }
    my $info_file = repo_dir()."$pkgname/@{[basename($pkgname)]}.info";
    my %info = parse_info_file($info_file);
    my $pkg = {
        PKGNAME         => $pkgname,
        PKGDIR          => repo_dir().$pkgname,
        INFO_FILE       => $info_file,
        SLACKBUILD_FILE => repo_dir().$pkgname.'/'.basename($pkgname).'.SlackBuild',
        DESC_FILE       => repo_dir().$pkgname.'/slack-desc',
        README_FILE     => repo_dir().$pkgname.'/README',
        PRGNAM          => $info{PRGNAM},
        VERSION         => $info{VERSION},
        HOMEPAGE        => $info{HOMEPAGE},
        MAINTAINER      => $info{MAINTAINER},
        EMAIL           => $info{EMAIL},
        DOWNLOAD        => [split ' ', $info{DOWNLOAD}],
        MD5SUM          => [split ' ', $info{MD5SUM}],
        DOWNLOAD_x86_64 => [split ' ', $info{DOWNLOAD_x86_64}],
        MD5SUM_x86_64   => [split ' ', $info{MD5SUM_x86_64}],
        REQUIRES        => [grep { prgnam_to_pkgname($_) } split(' ', $info{REQUIRES})], # removes %README% specifier and non-existent packages
        HAS_EXTRA_DEPS  => scalar(grep { $_ eq '%README%' } split(' ', $info{REQUIRES})),
        ARCH_UNSUPPORTED  => do {
            my @urls = split(' ', arch() eq 'x86_64' ? $info{DOWNLOAD_x86_64} : $info{DOWNLOAD});
            if    (grep { $_ eq 'UNSUPPORTED' } @urls) { 'unsupported' }
            elsif (grep { $_ eq 'UNTESTED'    } @urls) { 'untested'    }
            else                                       { 0             }
        }
    };
    $pkg_cache{$pkgname} = $pkg;
    return $pkg
}

sub pkgs_uniq {
    my @pkgs = @_;
    my %seen; my @pkgs_uniq;
    for my $pkg (@pkgs) {
        next if $seen{$pkg->{PKGNAME}};
        $seen{$pkg->{PKGNAME}} = 1;
        push @pkgs_uniq, $pkg;
    }
    return @pkgs_uniq;
}

sub pkgs_merged {
    my @pkgs = @_;
    my @pkgs_merged = pkgs_uniq(@pkgs);
    return @pkgs_merged;
}

sub pkgs_sorted {
    my @pkgs = @_;
    my @pkgs_uniq = pkgs_uniq(@pkgs);
    return sort { $a->{PKGNAME} cmp $b->{PKGNAME} } @pkgs_uniq;
}

sub pkg_array_minus {
    my ($pkg_aref1, $pkg_aref2) = @_;
    my @pkgs_minus = grep {
        my $pkg = $_; !grep { $pkg->{PKGNAME} eq $_->{PKGNAME} } @$pkg_aref2
    } @$pkg_aref1;
    return @pkgs_minus;
}

sub pkgs_confirm_with_user {
    my @pkgs = @_;
    print '    ', $_->{PKGNAME}, "\n" for @pkgs;
    print '  (y/n) -> ';
    my $user_input = <STDIN>;
    $user_input =~ s/^\s+|\s+$//g;
    return $user_input =~ /^y(?:es)?$/ ? 1 : 0;
}

sub pkg_installed {
    my ($pkg) = @_;
    my %installed_sbo_pkgs = installed_sbo_pkgs();
    my $version = $installed_sbo_pkgs{$pkg->{PKGNAME}};
    return $version;
}

sub pkg_installed_and_up_to_date {
    my ($pkg) = @_;
    my $installed_version = pkg_installed($pkg);
    if (!defined $installed_version or version_gt($pkg->{VERSION}, $installed_version)) {
        return 0;
    } else {
        return 1;
    }
}

sub pkg_matches_blacklist {
    my ($pkg, $blacklist_file) = @_;
    state %blacklist_cache;
    my $pkgnames = $blacklist_cache{$blacklist_file};
    if (!defined $pkgnames) {
        my $fh = sbozyp_open('<', $blacklist_file);
        my @pkgnames;
        while (<$fh>) {
            chomp;
            s/#.*//;            # no comments
            s/^\s+//;           # no leading whitespace
            s/\s+$//;           # no trailing whitespace
            next unless length; # is there anything left?
            if (my $pkgname = prgnam_to_pkgname($_)) {
                push @pkgnames, $pkgname;
            }
        }
        $pkgnames = $blacklist_cache{$blacklist_file} = \@pkgnames;
    }
    for my $pkgname (@$pkgnames) {
        return 1 if $pkg->{PKGNAME} eq $pkgname;
    }
    return 0;
}

sub parse_slackware_pkgname {
    my ($slackware_pkgname) = @_;
    my ($prgnam, $version) = $slackware_pkgname =~ /^([\w-]+)-([^-]*)-[^-]*-\d+_SBo$/;
    my $pkgname = prgnam_to_pkgname($prgnam);
    return ($pkgname => $version);
}

sub installed_sbo_pkgs {
    my $root = $ENV{ROOT} // '/';
    my %installed_sbo_pkgs;
    if (-d "$root/var/lib/pkgtools/packages") {
        %installed_sbo_pkgs = map {
            my ($pkgname, $version) = parse_slackware_pkgname(basename($_));
            # If $pkgname is undef then the current repo doesnt have the package. We only manage packages in the current repo.
            defined $pkgname ? ($pkgname, $version) : ();
        } grep /_SBo$/, sbozyp_readdir("$root/var/lib/pkgtools/packages");
    }
    return %installed_sbo_pkgs;
}

sub all_pkg_categories {
    state @all_pkg_categories = do {
        my $repo_dir = repo_dir();
        sort map { basename($_) } grep {
            basename($_) !~ /^\./ && -d $_;
        } sbozyp_readdir($repo_dir);
    };
    return @all_pkg_categories;
}

sub all_pkgnames {
    state @all_pkgnames = do {
        my $repo_dir = repo_dir();
        my @all_pkgnames;
        for my $category (all_pkg_categories()) {
            my @all_category_pkgnames = map { path_to_pkgname($_) } sbozyp_readdir("$repo_dir/$category");
            push @all_pkgnames, @all_category_pkgnames;
        }
        sort @all_pkgnames;
    };
    return @all_pkgnames;
}

sub prgnam_to_pkgname { # if $prgnam is already a pkgname its just returned back
    my ($prgnam) = @_; $prgnam or return;
    state %pkgname_cache; if (my $pkgname = $pkgname_cache{$prgnam}) { return $pkgname }
    my $pkgname;
    if ($prgnam =~ m,^[^/]+/[^/]+$, && -d repo_dir().$prgnam) {
        $pkgname = $prgnam;
    } else {
        for my $category (all_pkg_categories()) {
            if (-d repo_dir()."$category/$prgnam") {
                $pkgname = "$category/$prgnam";
                last;
            }
        }
    }
    $pkgname_cache{$prgnam} = $pkgname;
    return $pkgname;
}

sub path_to_pkgname {
    my ($path) = @_;
    my $pkgname = basename(dirname($path)).'/'.basename($path);
    return $pkgname;
}

sub parse_info_file {
    my ($info_file) = @_;
    my $fh = sbozyp_open('<', $info_file);
    my $info_file_content = do { local $/; <$fh> }; # slurp the info file
    my %info = $info_file_content =~ /^(\w+)="([^"]*)"/mg;
    # Multiline values are broken up with newline escapes. Lets squish them into single spaces.
    $info{$_} =~ s/\\\n\s+//g for keys %info;
    return %info;
}

sub pkg_dependencies_direct {
    my ($pkg) = @_;
    my @deps = map { pkg($_) } @{$pkg->{REQUIRES}};
    return @deps;
}

sub pkg_dependencies_recursive {
    my ($pkg) = @_;
    my @deps;
    my $resolve_deps = sub {
        my ($pkg) = @_;
        for my $dep (pkg_dependencies_direct($pkg)) {
            @deps = grep { $dep->{PKGNAME} ne $_->{PKGNAME} } @deps;
            unshift @deps, $dep;
            __SUB__->($dep);
        }
    };
    $resolve_deps->($pkg);
    return @deps;
}

sub pkg_queue {
    my ($pkg) = @_;
    my @deps = pkg_dependencies_recursive($pkg);
    my @queue = (@deps, $pkg);
    return @queue;
}

sub pkg_dependents_direct {
    my ($pkg) = @_;
    my @dependents;
    my @installed_sbo_pkgs = keys %{{ installed_sbo_pkgs() }};
    for my $pkgname (@installed_sbo_pkgs) {
        my $pkg_ = pkg($pkgname);
        my @deps = pkg_dependencies_direct($pkg_);
        push @dependents, $pkg_ if grep { $pkg->{PKGNAME} eq $_->{PKGNAME} } @deps;
    }
    @dependents = pkgs_sorted(@dependents);
    return @dependents;
}

sub pkg_dependents_recursive {
    my ($pkg) = @_;
    my @dependents;
    my %seen;
    my $resolve_dependents = sub {
        my @pkgs = @_;
        for my $pkg (@pkgs) {
            next if $seen{$pkg->{PKGNAME}};
            $seen{$pkg->{PKGNAME}} = 1;
            push @dependents, $pkg;
            __SUB__->(pkg_dependents_direct($pkg));
        }
    };
    $resolve_dependents->(pkg_dependents_direct($pkg));
    @dependents = pkgs_sorted(@dependents);
    return @dependents;
}

sub pkgs_no_dependents {
    my @pkgs_no_dependents;
    my @installed_sbo_pkgs = keys %{{ installed_sbo_pkgs() }};
    for my $pkgname (@installed_sbo_pkgs) {
        my $pkg = pkg($pkgname);
        push @pkgs_no_dependents, $pkg if 0 == pkg_dependents_direct($pkg);
    }
    @pkgs_no_dependents = pkgs_sorted(@pkgs_no_dependents);
    return @pkgs_no_dependents;
}

sub pkgs_removable_dependencies {
    my @pkgs = @_; # we assume all pkgs in @pkgs are actually installed
    my %pkgs; $pkgs{$_->{PKGNAME}} = $_ for @pkgs;
    my %deps; for my $pkg (@pkgs) {
        for my $dep (pkg_dependencies_direct($pkg)) {
            next if exists $pkgs{$dep->{PKGNAME}};
            if (defined pkg_installed($dep)) {
                $deps{$dep->{PKGNAME}} = $dep;
                for my $dep (pkg_dependencies_recursive($dep)) {
                    next if exists $pkgs{$dep->{PKGNAME}};
                    $deps{$dep->{PKGNAME}} = $dep if defined pkg_installed($dep);
                }
            }
        }
    }
    for my $installed_sbo_pkg (map { pkg($_) } keys %{{ installed_sbo_pkgs() }}) {
        next if exists $pkgs{$installed_sbo_pkg->{PKGNAME}};
        next if exists $deps{$installed_sbo_pkg->{PKGNAME}};
        for my $dep (pkg_dependencies_direct($installed_sbo_pkg)) {
            if ($deps{$dep->{PKGNAME}}) {
                $deps{$dep->{PKGNAME}} = 0;
                for my $dep (pkg_dependencies_recursive($dep)) {
                    $deps{$dep->{PKGNAME}} = 0 if exists $deps{$dep->{PKGNAME}};
                }
            }
        }
    }
    my @removable_deps; for my $pkgname (keys %deps) {
        if (my $dep = $deps{$pkgname}) {
            push @removable_deps, $dep;
        }
    }
    @removable_deps = pkgs_sorted(@removable_deps);
    return @removable_deps;
}

sub pkg_prepare_for_build {
    my ($pkg, $keep_src) = @_;
    my $arch = arch();
    if (my $arch_problem = $pkg->{ARCH_UNSUPPORTED}) {
        sbozyp_die("$pkg->{PKGNAME} is $arch_problem on $arch");
    }
    my %url_md5;
    if ($arch eq 'x86_64' and my @urls = @{$pkg->{DOWNLOAD_x86_64}}) {
        @url_md5{@urls} = @{$pkg->{MD5SUM_x86_64}};
    } else {
        my @urls = @{$pkg->{DOWNLOAD}};
        @url_md5{@urls} = @{$pkg->{MD5SUM}};
    }
    my $staging_dir = File::Temp->newdir(DIR => $CONFIG{TMPDIR}, TEMPLATE => 'sbozyp_XXXXXX');
    sbozyp_copy($pkg->{PKGDIR}, $staging_dir);
    for my $url (sort keys %url_md5) {
        my $src_filename = basename(decode_url($url));
        if ($keep_src && -r "$CONFIG{SRCDIR}/$src_filename") {
            # Sources stored from previous downloads have already been md5 checked
            sbozyp_print_stderr("$pkg->{PKGNAME}: using previously downloaded src: $src_filename\n");
            sbozyp_copy("$CONFIG{SRCDIR}/$src_filename", "$staging_dir/$src_filename");
        } else {
            my $md5 = $url_md5{$url};
            sbozyp_system('wget', '-e', 'background=off', '-O', "$staging_dir/$src_filename", $url);
            my $got_md5 = do {
                my $fh = sbozyp_open('<', "$staging_dir/$src_filename");
                binmode($fh);
                Digest::MD5->new->addfile($fh)->hexdigest;
            };
            if ($md5 ne $got_md5) {
                sbozyp_die("md5sum mismatch for '$url': expected '$md5': got '$got_md5'");
            }   
            if ($keep_src) {
                sbozyp_mkdir($CONFIG{SRCDIR});
                sbozyp_copy("$staging_dir/$src_filename", "$CONFIG{SRCDIR}/$src_filename");
            }
        }	
    }
    return $staging_dir;
}

sub build_slackware_pkg {
    my ($pkg, $keep_src) = @_;
    local $ENV{OUTPUT} = $CONFIG{TMPDIR}; # all SlackBuilds use the $OUTPUT env var to determine output pkg location
    sbozyp_mkdir($CONFIG{TMPDIR});
    my $staging_dir = pkg_prepare_for_build($pkg, $keep_src);
    my $slackbuild = $pkg->{PRGNAM} . '.SlackBuild';
    my $cmd = with_cwd($staging_dir, sub {
        sbozyp_chmod(0755, "./$slackbuild");
        return sbozyp_open('-|', "./$slackbuild");
    });
    my $slackware_pkg; while (my $line = <$cmd>) {
        $slackware_pkg = $1 if $line =~ /^Slackware package (.+) created\.$/;
        print $line; # magically knows to print to stdout or stderr
    }
    close $cmd;
    sbozyp_die("failed to build $pkg->{PKGNAME}") if $? != 0;
    sbozyp_die("successfully built $pkg->{PKGNAME} but couldn't determine the path of the created Slackware package") if !defined $slackware_pkg;
    return $slackware_pkg;
}

sub built_slackware_pkg {
    my ($pkg) = @_;
    my $output = $CONFIG{TMPDIR};
    return [ glob "$output/$pkg->{PRGNAM}*$pkg->{VERSION}*_SBo*" ]->[0];
}

sub install_slackware_pkg {
    my ($slackware_pkg) = @_;
    sbozyp_system('upgradepkg', '--reinstall', '--install-new', $slackware_pkg);
}

sub remove_slackware_pkg {
    my ($slackware_pkg) = @_;
    sbozyp_system('removepkg', $slackware_pkg);
}

            ####################################################
            #               REPOSITORY MANAGEMENT              #
            ####################################################

sub set_repo_name_or_die {
    my ($repo_name) = @_;
    my $repo_num = repo_name_repo_num($repo_name);
    if (defined $repo_num) {
        $CONFIG{REPO_NAME} = $repo_name;
    } else {
        sbozyp_die("no repo named '$repo_name'");
    }
}

sub repo_name_repo_num {
    my ($repo_name) = @_;
    my $repo_num;
    for my $k (grep /^REPO_.+_NAME/, sort keys %CONFIG) {
        my $v = $CONFIG{$k};
        if ($v eq $repo_name) {
            ($repo_num) = $k =~ /^REPO_(\d+)_NAME/;
        }
    }
    return $repo_num;
}

sub repo_num_git_branch {
    my ($repo_num) = @_;
    for my $k (sort keys %CONFIG) {
        return $CONFIG{$&} if $k =~ /^REPO_\Q$repo_num\E_GIT_BRANCH$/;
    }
}

sub repo_num_git_url {
    my ($repo_num) = @_;
    for my $k (sort keys %CONFIG) {
        return $CONFIG{$&} if $k =~ /^REPO_\Q$repo_num\E_GIT_URL$/;
    }
}

sub repo_git_branch {
    my $repo_num = repo_name_repo_num($CONFIG{REPO_NAME});
    my $repo_git_branch = repo_num_git_branch($repo_num);
    return $repo_git_branch;
}

sub repo_git_url {
    my $repo_num = repo_name_repo_num($CONFIG{REPO_NAME});
    my $repo_git_url = repo_num_git_url($repo_num);
    return $repo_git_url;
}

sub repo_dir {
    state $repo_dir = do {
        my $repo_root = $CONFIG{REPO_ROOT};
        $repo_root =~ s,/+,/,g; $repo_root =~ s,/+$,,;
        $repo_root.'/'.$CONFIG{REPO_NAME}.'/';
    };
    return $repo_dir;
}

sub repo_is_cloned {
    return -d repo_dir().'.git' ? 1 : 0;
}

sub clone_repo {
    my $repo_dir = repo_dir();
    sbozyp_mkdir($repo_dir);
    if (repo_is_cloned()) {
        sbozyp_rmdir_rec($repo_dir);
        sbozyp_mkdir($repo_dir);
    }
    my $repo_git_branch = repo_git_branch();
    my $repo_git_url = repo_git_url();
    sbozyp_system('git', 'clone', '--single-branch', '--branch', $repo_git_branch, '--no-tags', $repo_git_url, $repo_dir);
}

sub sync_repo {
    my $repo_dir = repo_dir();
    if (repo_is_cloned()) {
        my $repo_git_branch = repo_git_branch();
        with_stdout_to_stderr(sub {
            sbozyp_system('git', '-C', $repo_dir, 'fetch', '--verbose');
            sbozyp_system('git', '-C', $repo_dir, 'reset', '--hard', "origin/$repo_git_branch");
        });
    } else {
        sbozyp_die("cannot sync non-existent git repository at '$repo_dir'");
    }
}

            ####################################################
            #               CONFIGURATION & HELP               #
            ####################################################

sub parse_config_file {
    my ($config_file) = @_;
    my $fh = sbozyp_open('<', $config_file);
    while (<$fh>) {
        chomp;
        my $line_copy = $_; # save $_ so we can create a nice error message if things go wrong
        s/#.*//;            # no comments
        s/^\s+//;           # no leading whitespace
        s/\s+$//;           # no trailing whitespace
        s/\/+$//;           # no trailing /'s
        next unless length; # is there anything left?
        my ($k, $v) = split /\s*=\s*/, $_, 2;
        $k !~ /^\s*$/ && $v !~ /^\s*$/ or sbozyp_die("could not parse line $. '$line_copy': '$config_file'");
        $CONFIG{$k} = $v;
    }
}

sub sbozyp_getopts {
    my $err_prefix = (caller(1))[3] =~ /main_([a-z]+)$/ ? "$1: " : '';
    my $getopt_err;
    local $SIG{__WARN__} = sub { chomp($getopt_err = lcfirst $_[0]) };
    GetOptionsFromArray(@_) or sbozyp_die($err_prefix.$getopt_err);
}

sub sbozyp_pod2usage {
    my ($sections) = @_;
    my $fh = sbozyp_open('>', \my $pod);
    pod2usage(
        -input    => __FILE__,
        -output   => $fh,
        -exitval  => 'NOEXIT',
        -verbose  => 99,
        -sections => $sections
    );
    return $pod;
}

sub command_usage {
    my ($cmd) = @_;
    my $pod = sbozyp_pod2usage($cmd eq 'main' ? 'OVERVIEW' : 'COMMANDS/'.uc($cmd));
    my $usage = ($pod =~ /(Usage:[^\n]+)/s)[0];
    return "$usage\n";
}

sub command_help_msg {
    my ($cmd) = @_;
    my $pod = sbozyp_pod2usage($cmd eq 'main' ? 'OVERVIEW' : 'COMMANDS/'.uc($cmd));
    my @pod = split "\n", $pod; @pod = @pod[1..$#pod];
    $pod[0] =~ s/^ //;
    $_ =~ s/^.{4}// for @pod;
    $pod = join("\n", @pod) . "\n";
    return $pod;
}

            ####################################################
            #                     UTILITIES                    #
            ####################################################

sub sbozyp_system {
    my @cmd = @_;
    my $result = system(@cmd); my $status = $result >> 8; my $signal = $result & 127;
    if (0 != $status) {
        sbozyp_die("the following system command exited with status $status: @cmd");
    } elsif (0 != $signal) {
        sbozyp_die("the following system command was killed by signal $signal: @cmd");
    }
    return $status;
}

sub sbozyp_qx {
    my ($cmd) = @_;
    wantarray ? chomp(my @output = qx($cmd)) : chomp(my $output = qx($cmd));
    my $result = $?; my $status = $result >> 8; my $signal = $result & 127;
    if (0 != $status) {
        sbozyp_die("the following system command exited with status $status: $cmd");
    } elsif (0 != $signal) {
        sbozyp_die("the following system command was killed by signal $signal: $cmd");
    }
    return wantarray ? @output : $output;
}

sub with_stdout_to_stderr {
    my ($sub) = @_;
    open(my $orig_stdout, '>&', \*STDOUT) or sbozyp_die("failed to dup STDOUT: $!");
    open(STDOUT, '>&=', \*STDERR) or sbozyp_die("failed to redirect STDOUT to STDERR: $!");
    my $ret = $sub->();
    open(STDOUT, '>&=', $orig_stdout) or sbozyp_die("failed to restore STDOUT: $!");
    return $ret;
}

sub with_cwd {
    my ($dir, $sub) = @_;
    my $orig_cwd = Cwd::getcwd();
    sbozyp_chdir($dir);
    my $ret = eval { $sub->() }; my $err = $@;
    sbozyp_chdir($orig_cwd);
    if ($err) { $! = 1; die $err };
    return $ret;
}

sub arch {
    state $arch = sbozyp_qx('uname -m');
    return $arch;
}

sub i_am_root {
    return 0 == $> ? 1 : 0;
}

sub i_am_root_or_die {
    my ($msg) = @_;
    sbozyp_die($msg // 'must be root') unless i_am_root();
}

sub decode_url { # https://stackoverflow.com/a/4510561/13603478
    my ($url) = @_;
    my $decoded = $url =~ s/%([A-Fa-f\d]{2})/chr hex $1/egr;
    return $decoded;
}

# The internal algorithm of version_gt() is copy and pasted directly from the
# Sort::Versions CPAN module's versioncmp() function. We copy and paste this
# here instead of depending on Sort::Versions as we don't wish for sbozyp to
# have any dependencies. Note that sbotools also uses Sort::Versions for version
# comparisons.
sub version_gt {
    my ($v1, $v2) = @_;
    my @v1 = ($v1 =~ /([-.]|\d+|[^-.\d]+)/g);
    my @v2 = ($v2 =~ /([-.]|\d+|[^-.\d]+)/g);
    while (@v1 and @v2) {
        $v1 = shift @v1;
        $v2 = shift @v2;
        if ($v1 eq '-' and $v2 eq '-') {
            next;
        } elsif ( $v1 eq '-' ) {
            return 0;
        } elsif ( $v2 eq '-') {
            return 1;
        } elsif ($v1 eq '.' and $v2 eq '.') {
            next;
        } elsif ( $v1 eq '.' ) {
            return 0;
        } elsif ( $v2 eq '.' ) {
            return 1;
        } elsif ($v1 =~ /^\d+$/ and $v2 =~ /^\d+$/) {
            if ($v1 =~ /^0/ || $v2 =~ /^0/) {
                my $cmp = $v1 cmp $v2;
                return 0 if $cmp < 0;
                return 1 if $cmp > 0;
            } else {
                my $cmp = $v1 <=> $v2;
                return 0 if $cmp < 0;
                return 1 if $cmp > 0;
            }
        } else {
            $v1 = uc $v1;
            $v2 = uc $v2;
            my $cmp = $v1 cmp $v2;
            return 0 if $cmp < 0;
            return 1 if $cmp > 0;
        }
    }
    return @v1 > @v2 ? 1 : 0;
}

sub sbozyp_mkdir {
    my @dirs = @_;
    for my $dir (@dirs) {
        unless (-d $dir) {
            make_path($dir, {error => \my $err});
            if ($err) {
                for my $diag (@$err) {
                    my (undef, $err_msg) = %$diag;
                    sbozyp_die("could not mkdir '$dir': $err_msg");
                }
            }
        }
    }
    return @dirs;
}

sub sbozyp_rmdir_rec {
    my ($dir) = @_;
    if (-d $dir) {
        remove_tree($dir, {error => \my $err});
        if ($err) {
            for my $diag (@$err) {
                my (undef, $err_msg) = %$diag;
                sbozyp_die("could not recursively delete directory '$dir': $err_msg");
            }
        }
    }
}

sub sbozyp_copy {
    my ($file, $dest) = @_;
    sbozyp_system('cp', '-a', -d $file ? "$file/." : $file, $dest);
}

sub sbozyp_readdir {
    my ($dir) = @_;
    opendir(my $dh, $dir) or sbozyp_die("could not opendir '$dir': $!");
    my @files = sort map { "$dir/$_" } grep { !/^\.\.?$/ } readdir($dh);
    return @files;
}

sub sbozyp_open {
    my ($mode, $path) = @_;
    open(my $fh, $mode, $path) or sbozyp_die("could not open file '$path': $!");
    return $fh;
}

sub sbozyp_unlink {
    my ($file) = @_;
    unlink $file or sbozyp_die("could not unlink file '$file': $!");
}

sub sbozyp_chmod {
    my ($mode, $file) = @_;
    chmod $mode, $file or sbozyp_die(sprintf("could not chmod 0%o '%s': %s", $mode, $file, $!));
}

sub sbozyp_chdir {
    my ($dir) = @_;
    chdir $dir or sbozyp_die("could not chdir '$dir': $!");
}

sub sbozyp_print_file {
    my ($file) = @_;
    my $fh = sbozyp_open('<', $file);
    print while <$fh>;
}

sub sbozyp_error_prefix {
    return 'sbozyp: error: ';
}

sub sbozyp_die {
    $! = 1;
    die sbozyp_error_prefix(), @_, "\n";
}

sub sbozyp_msg_prefix {
    return 'sbozyp: ';
}

sub sbozyp_print {
    print sbozyp_msg_prefix(), @_;
}

sub sbozyp_print_stderr {
    print STDERR sbozyp_msg_prefix(), @_;
}

1;

__END__

            ####################################################
            #                      MANUAL                      #
            ####################################################

=pod

=head1 NAME

sbozyp - A package manager for Slackware's SlackBuilds.org

=head1 DESCRIPTION

Sbozyp is a command-line package manager for the SlackBuilds.org package
repository. SlackBuilds.org is a collection of third-party SlackBuild scripts
used to build Slackware packages.

Sbozyp assumes its users have an understanding of SlackBuilds and the
SlackBuilds.org repository. While sbozyp provides conveniences to make it easier
to build, install, and remove packages, users should always understand every
package they consider installing by reading its README file.

Sbozyp does not handle optional dependencies or setting build-time options, so
users must deal with these special cases manually.

=head1 OVERVIEW

 Usage: sbozyp [global_opts] <command> [command_opts] <command_args>

Every command has its own options, these are just the global ones:

 -C            Re-clone SBo repository before running the command
 -F FILE       Use FILE as the configuration file
 -R REPO_NAME  Use SBo repository REPO_NAME instead of REPO_PRIMARY
 -S            Sync SBo repository before running the command
 -T            Exit if the SBo repository hasn't been cloned yet

Commands:

 install|in    Install or update packages
 build|bu      Build but don't install packages
 remove|rm     Remove packages
 query|qr      Query for information about a package
 search|se     Search for a package using a Perl regex
 null|nu       Do nothing, useful in conjunction with -C or -S opts

Examples:

 sbozyp --help
 sbozyp --version
 sbozyp install --help
 sbozyp install -S -R $REPO -f xclip system/password-store
 sbozyp -T build -f mu
 sbozyp remove xclip password-store
 sbozyp query -q password-store
 sbozyp search -n system/.+
 sbozyp -R $REPO -C null

=head1 CONFIGURATION

Sbozyp is configured via the C</etc/sbozyp/sbozyp.conf> file. An alternative
configuration file can be specified with the C<-F> option.

=head2 REPOSITORY DEFINITIONS

You can define as many repositories as you want in the configuration file. A
repository definition requires these 3 variables to be set ($N is any
non-negative integer):

 REPO_$N_NAME
 REPO_$N_GIT_URL
 REPO_$N_GIT_BRANCH

Example:

 REPO_7_NAME=fifteenpoint0
 REPO_7_GIT_URL=git://git.slackbuilds.org/slackbuilds.git
 REPO_7_GIT_BRANCH=15.0

This defines a repository that will be downloaded with git with a command like:
C<git clone --branch $REPO_7_GIT_BRANCH $REPO_7_GIT_URL>.

You can use this repository with sbozyp by specifying its name (fifteenpoint0)
with the C<-R> option. You can also make this repository the default (used when
C<-R> is omitted) by setting C<REPO_PRIMARY=fifteenpoint0> in your configuration
file.

Repo names should never contain any forward slash characters (C</>).

=head2 OTHER CONFIGURATION VARIABLES

=head3 REPO_PRIMARY

The name of the repo to use by default when not specifying one with the C<-R>
flag. There is no default value for this variable.

=head3 REPO_ROOT

The directory to store local copies of SBo.

Defaults to C<REPO_ROOT=/var/lib/sbozyp/SBo>.

=head3 TMPDIR

The directory used for placing working files.

Defaults to C<TMPDIR=/tmp>.

=head3 SRCDIR

The directory used to save downloaded source files for reuse when using the
install and build commands -z flag.
 
Defaults to C<SRCDIR=/var/lib/sbozyp/source-cache>.

=head1 COMMANDS

=head2 INSTALL

 Usage: sbozyp <install|in> [-h] [-b FILE] [-f] [-k] [-r] [-y] [-z] <pkgname...>

Install or update packages.

Options are:

 -h|--help     Print help message and exit
 -b FILE       Use FILE as blacklist instead of /etc/sbozyp/sbozyp.blacklist
 -f            Force install/update even if package is up to date or blacklisted
 -k            Keep the built package (resides in TMPDIR)
 -r            Install package dependencies recursively
 -y            No interactive prompt
 -z            Keep and reuse downloaded sources (reside in SRCDIR)

Examples:

 sbozyp install --help
 sbozyp in password-store
 sbozyp in -r xclip mu password-store
 sbozyp in -k -r system/password-store
 sbozyp in -f -i -r password-store
 sbozyp -S -R $REPO in -f -r password-store
 sbozyp in -r $(sbozyp -S qr -u) ### update all packages

=head2 BUILD

 Usage: sbozyp <build|bu> [-h] [-f] [-y] [-z] <pkgname...>

Build but don't install packages.

Options are:

 -h|--help     Print help message and exit
 -f            Force rebuilding the package even if it's already built
 -y            No confirmation prompt
 -z            Keep and reuse downloaded sources (reside in SRCDIR)

Examples:

 sbozyp build --help
 sbozyp bu password-store
 sbozyp bu -f password-store
 sbozyp bu -f -i system/password-store
 sbozyp -S -R $REPO bu password-store
 sbozyp bu -i system/password-store xclip mu

=head2 REMOVE

 Usage: sbozyp <remove|rm> [-h] [-f] [-r] [-y] <pkgname...>

Remove packages.

Options are:

 -h|--help     Print help message and exit
 -f            Disable removal safety check (DANGEROUS)
 -r            Recursively remove package dependencies that are safe to remove
 -y            No confirmation prompt

Examples:

 sbozyp remove --help
 sbozyp rm xclip mu system/password-store
 sbozyp rm -i -r password-store
 sbozyp -S -R $REPO rm password-store

=head2 QUERY

 Usage: sbozyp <query|qr> [-h] [-a] [-b] [-c] [-d] [-i] [-m] [-n] [-o] [-p] [-q] [-r] [-s] [-u] [-v] PKGNAME?

Query for package related information.

Exactly one option must be used in a single query command.

Options are:

 -h|--help     Print help message and exit
 -a            Print all installed packages
 -b            Print the path to PKGNAME's local package directory
 -c            Print the path to the current repositories directory
 -d            Print PKGNAME's slack-desc file
 -i            Print PKGNAME's info file
 -m            Print all installed SBo packages with no dependents
 -n            Print PKGNAME's recursive dependents
 -o            Print PKGNAME'S direct dependents
 -p            If PKGNAME is installed print the installed version number
 -q            Print PKGNAME's installation queue (finds PKGNAMES dependencies)
 -r            Print PKGNAME's README file
 -s            Print PKGNAME's .SlackBuild file
 -u            Print all packages that have updates available
 -v            Like -u, but also print the version information

Examples:

 sbozyp query --help
 sbozyp qr -q password-store
 sbozyp qr -m
 sbozyp -S qr -u
 cd $(sbozyp qr -b password-store)
 sbozyp -S -R $REPO qr -r password-store

=head2 SEARCH

 Usage: sbozyp <search|se> [-h] [-c] [-n] [-p] [-q] <regex>

Search for packages using a Perl regex.

Options are:

 -h|--help     Print help message and exit
 -c            Match case sensitive
 -n            Match against CATEGORY/PRGNAM instead of just PRGNAM
 -p            Print just the PRGNAM of matched packages
 -q            Suppress output if no matches are found

Examples:

 sbozyp search --help
 sbozyp se password-store
 sbozyp se -p -q password.+
 sbozyp se -c -n system/.+
 sbozyp -S -R $REPO se password-store

=head2 NULL

 Usage: sbozyp <null|nu> [-h]

Do nothing. Useful if you just want to re-clone (with global -C option) or
sync (with global -S option) a repository.

Options are:

 -h|--help     Print help message and exit

Examples:

 sbozyp null --help
 sbozyp nu
 sbozyp -R $REPO -S nu
 sbozyp -S nu

=head1 AUTHOR

Nicholas B. Hubbard (nicholashubbard@posteo.net)

=head1 COPYRIGHT

Copyright (c) 2023-2026 by Nicholas B. Hubbard (nicholashubbard@posteo.net)

=head1 LICENSE

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
sbozyp. If not, see http://www.gnu.org/licenses/.

=cut
