#!/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.0.1';

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);

$SIG{INT} = $SIG{TERM} = sub { die "\nsbozyp: got a signal to exit ... going down!\n" };

our %CONFIG = (
    # defaults
    TMPDIR => '/tmp',
    REPO_ROOT => '/var/lib/sbozyp/SBo',
    #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,
        '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();
    sbozyp_mkdir(repo_dir(), $CONFIG{TMPDIR});
    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,
        'f'      => \my $opt_force,
        'i'      => \my $opt_noninteractive,
        'k'      => \my $opt_keeppackage,
        'n'      => \my $opt_nodeps
    );
    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_nodeps ? ($pkg) : pkg_queue($pkg);
        unless ($opt_force) {
            @pkg_queue = grep { !pkg_installed_and_up_to_date($_) } @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);
            install_slackware_pkg($slackware_pkg);
            sbozyp_unlink($slackware_pkg) unless $opt_keeppackage;
        }
    } else {
        sbozyp_print("all packages (and their deps) requested for installation are up to date, invoke with -f option to force installation\n");
    }
}

sub main_build {
    sbozyp_getopts(
        \@_,
        'h|help' => \my $opt_help,
        'f'      => \my $opt_force,
        'i'      => \my $opt_noninteractive
    );
    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);
    }
}

sub main_remove {
    sbozyp_getopts(
        \@_,
        'h|help' => \my $opt_help,
        'f'      => \my $opt_nodepsafetycheck,
        'i'      => \my $opt_noninteractive,
        'r'      => \my $opt_removedeps
    );
    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_listneedupgrade
    );
    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_listneedupgrade) { $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_listneedupgrade ? '-u' : 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_listneedupgrade) {
        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
    );
    if ($opt_help) { print command_help_msg('search'); return }
    @_ == 1 or die command_usage('search');
    my $regex_arg = $_[0];
    my $regex = $opt_casesensitive ? qr/$regex_arg/ : qr/$regex_arg/i;
    my @matches = grep {
        $opt_matchcategory ? $_ =~ $regex : basename($_) =~ $regex;
    } all_pkgnames();
    if (@matches) {
        if ($opt_prgnam) {
            @matches = sort map { $_ = basename($_) } @matches;
        }
        print $_, "\n" for @matches
    } else {
        sbozyp_die("no packages match the regex '$regex_arg'");
    }
}

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 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) = @_;
    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 $md5 = $url_md5{$url};
        sbozyp_system('wget', '-P', $staging_dir, $url);
        my $file = basename($url);
        my $got_md5 = do {
            my $fh = sbozyp_open('<', "$staging_dir/$file");
            binmode($fh);
            Digest::MD5->new->addfile($fh)->hexdigest;
        };
        if ($md5 ne $got_md5) {
            sbozyp_die("md5sum mismatch for '$url': expected '$md5': got '$got_md5'");
        }
    }
    return $staging_dir;
}

sub build_slackware_pkg {
    my ($pkg) = @_;
    local $ENV{OUTPUT} = $CONFIG{TMPDIR}; # all SlackBuilds use the $OUTPUT env var to determine output pkg location
    my $staging_dir = pkg_prepare_for_build($pkg);
    my $slackbuild = $pkg->{PRGNAM} . '.SlackBuild';
    my $cmd = sbozyp_open('-|', "cd '$staging_dir' && chmod +x ./$slackbuild && ./$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();
    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', '--branch', $repo_git_branch, '--single-branch', $repo_git_url, $repo_dir);
}

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

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

sub parse_config_file {
    my ($config_file) = @_;
    $config_file = '/etc/sbozyp/sbozyp.conf' unless defined $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 $exit_status = system(@cmd) >> 8;
    unless (0 == $exit_status) {
        sbozyp_die("the following system command exited with status $exit_status: @cmd");
    }
    return $exit_status;
}

sub sbozyp_qx {
    my ($cmd) = @_;
    wantarray ? chomp(my @output = qx($cmd)) : chomp(my $output = qx($cmd));
    unless (0 == $?) {
        my $exit_status = $? >> 8;
        sbozyp_die("the following system command exited with status $exit_status: $cmd");
    }
    return wantarray ? @output : $output;
}

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();
}

# 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_print_file {
    my ($file) = @_;
    my $fh = sbozyp_open('<', $file);
    print while <$fh>;
}

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

sub sbozyp_die {
    die sbozyp_error_prefix(), @_, "\n";
}

sub sbozyp_msg_prefix {
    return 'sbozyp: ';
}

sub sbozyp_print {
    print 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.
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 upgrade 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>.

=head1 COMMANDS

=head2 INSTALL

 Usage: sbozyp <install|in> [-h] [-f] [-i] [-k] [-n] <pkgname...>

Install or upgrade packages.

Options are:

 -h|--help     Print help message
 -f            Force installation even if package is already up to date
 -i            No interactive prompt
 -k            Keep the built package (resides in TMPDIR)
 -n            Do not install package dependencies

Examples:

 sbozyp install --help
 sbozyp in password-store
 sbozyp in xclip mu password-store
 sbozyp in -k system/password-store
 sbozyp in -f -i -n password-store
 sbozyp -S -R $REPO in -f password-store
 sbozyp in $(sbozyp -S qr -u | cut -d' ' -f1) ### upgrade all packages

=head2 BUILD

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

Build but don't install packages.

Options are:

 -h|--help     Print help message
 -f            Force rebuilding the package even if it's already built
 -i            No confirmation prompt

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] [-i] [-r] <pkgname...>

Remove packages.

Options are:

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

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] [-d] [-i] [-m] [-n] [-o] [-p] [-q] [-r] [-s] [-u] PKGNAME?

Query for package related information.

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

Options are:

 -h|--help     Print help message
 -a            Print all installed SBo packages
 -b            Print the path to PKGNAME's local package 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 upgrades available

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 password-store

=head2 SEARCH

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

Search for a package using a Perl regex.

Options are:

 -h|--help     Print help message
 -c            Match case sensitive
 -n            Match against CATEGORY/PRGNAM instead of just PRGNAM
 -p            Print just the PRGNAM of matched packages

Examples:

 sbozyp search --help
 sbozyp se password-store
 sbozyp se -p 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

Examples:

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

=head1 AUTHOR

Nicholas Hubbard (nicholashubbard@posteo.net)

=head1 CONTRIBUTORS

=over 4

=item * Kat Nguyen

=item * pghvlaans

=back

=head1 COPYRIGHT

Copyright (c) 2023-2025 by Nicholas 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
