package Slackware::SBoKeeper::Database;
use 5.016;
our $VERSION = '2.00';
use strict;
use warnings;

use List::Util qw(any uniq);

my @VALID_FIELDS = qw(Deps Manual);

my $DELIMIT = '%%';

# SlackBuilds can put %README% in the REQUIRES to indicate the user should read
# the README for important information regarding dependencies. Since %README%
# doesn't actually exist as a package, we need to ignore it when it comes up.
my $DEP_README = '%README%';

sub write_data {

	my $data = shift;
	my $out  = shift;

	open my $fh, '>', $out or die "Failed to open $out for writing: $!\n";

	foreach my $p (sort keys %{$data}) {

		say { $fh } "PACKAGE: $p";
		say { $fh } "DEPS: ", join(' ', @{$data->{$p}->{Deps}});
		say { $fh } "MANUAL: $data->{$p}->{Manual}";
		say { $fh } $DELIMIT;

	}

	close $fh;

}

sub read_data {

	my $file = shift;
	my $data = {};

	open my $fh, '<', $file or die "Failed to open $file for reading: $!\n";

	my $pkg = '';
	my $lnum = 1;

	while (my $l = readline $fh) {

		chomp $l;

		if ($l eq $DELIMIT) {
			$pkg = '';
		} elsif ($l =~ /^PACKAGE: /) {
			$pkg = $l =~ s/^PACKAGE: //r;
			$data->{$pkg} = {};
		} elsif ($pkg eq '') {
			die "Bad line in $file at line $lnum: PACKAGE not set\n";
		} elsif ($l =~ /^DEPS: /) {
			my $depstr = $l =~ s/^DEPS: //r;
			@{$data->{$pkg}->{Deps}} = split /\s/, $depstr;
		} elsif ($l =~ /^MANUAL: /) {
			my $manual = $l =~ s/^MANUAL: //r;
			$data->{$pkg}->{Manual} = $manual eq '1' ? 1 : 0;
		} else {
			die "Bad line in $file at line $lnum\n";
		}

		$lnum++;

	}

	close $fh;

	return $data;

}

sub new {

	my $class  = shift;
	my $file   = shift;
	my $sbodir = shift;

	my $self = {
		_data   => {},
		_sbodir => '',
	};

	if ($file) {
		$self->{_data} = read_data($file);
	}

	$self->{_sbodir} = $sbodir;

	bless $self, $class;
	return $self;

}

sub add {

	my $self   = shift;
	my $pkgs   = shift;
	my $manual = shift;

	my @added;

	foreach my $p (@{$pkgs}) {

		unless ($self->exists($p)) {
			die "$p does not exist in SlackBuild repo\n";
		}

		# pkg already present, do not add. Set manual flag if desired.
		if (defined $self->{_data}->{$p}) {
			$self->{_data}->{$p}->{Manual} = $manual if $manual;
			next;
		}

		$self->{_data}->{$p}->{Manual} = $manual;

		my @deps = $self->real_immediate_dependencies($p);
		$self->{_data}->{$p}->{Deps} = \@deps;

		my @add = $self->add($self->{_data}->{$p}->{Deps}, 0);

		push @added, @add;
		push @added, $p;

	}

	return sort @added;

}

sub tack {

	my $self   = shift;
	my $pkgs   = shift;
	my $manual = shift;

	foreach my $p (@{$pkgs}) {

		unless ($self->exists($p)) {
			die "$p does not exist in SlackBuild repo\n";
		}

		if (defined $self->{_data}->{$p}) {
			$self->{_data}->{$p}->{Manual} = $manual if $manual;
		} else {
			$self->{_data}->{$p} = {
				Deps   => [],
				Manual => $manual,
			}
		}

	}

	return @{$pkgs};

}

sub remove {

	my $self = shift;
	my $pkgs = shift;

	my @rm;

	foreach my $p (@{$pkgs}) {

		unless (defined $self->{_data}->{$p}) {
			warn "$p not present in database, not removing\n";
			next;
		}

		delete $self->{_data}->{$p};

		push @rm, $p;

	}

	return sort @rm;

}

sub depadd {

	my $self = shift;
	my $pkg  = shift;
	my $deps = shift;

	unless ($self->has($pkg)) {
		die "$pkg is not present in database\n";
	}

	my @add;
	foreach my $d (@{$deps}) {

		unless ($self->has($d)) {
			warn "$d not present in database, skipping\n";
			next;
		}

		unless (any { $d eq $_ } @{$self->{_data}->{$pkg}->{Deps}}) {
			push @{$self->{_data}->{$pkg}->{Deps}}, $d;
			push @add, $d;
		}

	}

	return @add;

}

sub depremove {

	my $self = shift;
	my $pkg  = shift;
	my $deps = shift;

	my @kept;
	my @rm;
	foreach my $p (@{$self->{_data}->{$pkg}->{Deps}}) {
		if (any { $p eq $_ } @{$deps}) {
			push @rm, $p;
		} else {
			push @kept, $p;
		}
	}

	$self->{_data}->{$pkg}->{Deps} = \@kept;

	return @rm;

}

sub has {

	my $self = shift;
	my $pkg  = shift;

	return defined $self->{_data}->{$pkg};

}

sub packages {

	my $self = shift;
	my $cat  = shift;

	if (!$cat or $cat eq 'all') {
		return sort keys %{$self->{_data}};
	} elsif ($cat eq 'manual') {
		return grep { $self->is_manual($_) } $self->packages();
	} elsif ($cat eq 'nonmanual') {
		return grep { !$self->is_manual($_) } $self->packages();
	} elsif ($cat eq 'necessary') {
		return grep { $self->is_necessary($_) } $self->packages();
	} elsif ($cat eq 'unnecessary') {
		return grep { !$self->is_necessary($_) } $self->packages();
	} elsif ($cat eq 'missing') {
		my %missing = $self->missing();
		return uniq sort map { @{$missing{$_}} } keys %missing;
	} else {
		die "$cat is not a valid package category\n";
	}

}

sub missing {

	my $self = shift;

	my %missing;

	foreach my $p ($self->packages('all')) {

		my @pmissing =
			grep { !$self->has($_) }
			$self->real_immediate_dependencies($p);

		push @{$missing{$p}}, @pmissing if @pmissing;

	}

	return %missing;

}

sub extradeps {

	my $self = shift;

	my @pkgs = $self->packages('all');

	my %extra;

	foreach my $p (@pkgs) {

		my %realdeps = map { $_ => 1 } $self->real_immediate_dependencies($p);

		my @pextra =
			grep { !defined $realdeps{$_} }
			$self->immediate_dependencies($p);

		push @{$extra{$p}}, @pextra if @pextra;

	}

	return %extra;

}

sub is_necessary {

	my $self = shift;
	my $pkg  = shift;

	unless (defined $self->{_data}->{$pkg}) {
		return 0;
	}

	if ($self->{_data}->{$pkg}->{Manual}) {
		return 1;
	}

	# Check if $pkg is a dependency of any manually installed package
	return (any { $self->is_dependency($pkg, $_) } $self->packages('manual'))
		? 1 : 0;

}

sub is_dependency {

	my $self = shift;
	my $dep  = shift;
	my $of   = shift;

	foreach my $p (@{$self->{_data}->{$of}->{Deps}}) {

		if ($p eq $dep) {
			return 1;
		}

		if ($self->is_dependency($dep, $p)) {
			return 1;
		}

	}

	return 0;

}

sub is_manual {

	my $self = shift;
	my $pkg  = shift;

	return $self->{_data}->{$pkg}->{Manual} ? 1 : 0;

}

sub exists {

	my $self = shift;
	my $pkg  = shift;

	return 1 if $pkg eq $DEP_README;

	if (() = glob "$self->{_sbodir}/*/$pkg/$pkg.info") {
		return 1;
	} else {
		return 0;
	}

}

sub dependencies {

	my $self = shift;
	my $pkg  = shift;

	my @deps;

	@deps = $self->immediate_dependencies($pkg);

	foreach my $d (@deps) {
		push @deps, $self->dependencies($d);
	}

	return uniq sort @deps;

}

sub immediate_dependencies {

	my $self = shift;
	my $pkg  = shift;

	return sort @{$self->{_data}->{$pkg}->{Deps}};

}

sub real_dependencies {

	my $self = shift;
	my $pkg  = shift;

	my @deps;

	@deps = $self->real_immediate_dependencies($pkg);

	foreach my $d (@deps) {
		push @deps, $self->real_dependencies($d);
	}

	return uniq sort @deps;

}

sub real_immediate_dependencies {

	my $self = shift;
	my $pkg  = shift;

	my @deps;

	my ($info) = glob "$self->{_sbodir}/*/$pkg/$pkg.info";

	die "Could not find $pkg in $self->{_sbodir}\n" unless $info;

	open my $fh, '<', $info
		or die "Failed to open $info for reading: $!\n";

	while (my $l = readline $fh) {

		chomp $l;

		next unless $l =~ /^REQUIRES=".*("|\\)$/;

		my ($depstr) = $l =~ /^REQUIRES="(.*)("|\\)/;

		@deps = grep { $_ ne $DEP_README } split(/\s/, $depstr);

		while (substr($l, -1) eq '\\') {

			$l = readline $fh;
			chomp $l;

			($depstr) = $l =~ /(^.*)("|\\)/;

			push @deps, grep { $_ ne $DEP_README } split(" ", $depstr);

		}

		last;

	}

	close $fh;

	return sort @deps;

}

sub unmanual {

	my $self = shift;
	my $pkg  = shift;

	unless (defined $self->{_data}->{$pkg}) {
		return 0;
	}

	$self->{_data}->{$pkg}->{Manual} = 0;

	return 1;

}

sub write {

	my $self = shift;
	my $path = shift;

	write_data($self->{_data}, $path);

}

1;



=head1 NAME

Slackware::SBoKeeper::Database - Read/write sbokeeper databases

=head1 SYNOPSIS

 use Slackware::SBoKeeper::Database;

 my $database = Slackware::SBoKeeper::Database->new($file, $repo);
 ...

=head1 DESCRIPTION

Slackware::SBoKeeper::Database is a module that handles reading and writing
L<sbokeeper> package database files. It is not meant to be used outside of
L<sbokeeper>. For user documentation of L<sbokeeper>, please consult its manual.

=head1 SUBROUTINES/METHODS

=head2 new($path, $sbodir)

Returns blessed Slackware::SBoKeeper::Database object. $path is the path to a
file containing B<sbokeeper> data. If $path is '', creates an empty
database. $sbodir is the directory where the SBo repository is stored.

=head2 add($pkgs, $manual)

Add array ref of pkgs and their dependencies to object. If $manual is true,
$pkgs are set to manually added (dependencies are still not).

Returns array of packages added.

=head2 tack($pkgs, $manual)

Add array ref of pkgs to database. $manual determines whether they are marked
as manually added or not. Does not pull in dependencies.

Returns array of packages added.

=head2 remove($pkgs)

Remove array ref pkgs from object. Dependencies pulled in from removed packages
will still remain.

Returns array of packages removed.

=head2 depadd($pkg, $deps)

Add array ref $deps to $pkg's dependencies. $deps must be a list of packages
already present in the database.

Returns list of dependencies added to $pkg.

=head2 depremove($pkg, $deps)

Removes array ref $deps from $pkg's dependency list.

Returns list of dependencies removed.

=head2 has($pkg)

Returns 1 or 0 depending on whether $pkg is currently in the database.

=head2 packages($category)

Returns array of added packages that are in $category. The following are valid
categories:

=over 4

=item all

All packages present in database.

=item manual

All packages that were added manually.

=item nonmanual

All packages that were not added manually.

=item necessary

Packages that were either manually added or dependencies of a manually added
package.

=item unnecessary

Packages that were neither manually added or dependencies of a manually added
package.

=item missing

Packages that are not present in the database but are needed by packages in the
database.

=back

If $category is omitted, do the same thing as 'all'.

=head2 missing()

Returns hash of packages and their missing dependencies, according to the
SlackBuild repo.

=head2 extradeps()

Returns hash of packages with extra dependencies. An extra dependency is a
dependency that is not required by the package in the SlackBuild repo.

=head2 is_necessary($pkg)

Checks to see if $pkg is necessary (manually added or dependency on a manually
added package). Returns 1 for yes, 0 for no.

=head2 is_dependency($dep, $of)

Checks to see if $dep is a dependency (or a dependency of a dependency, etc.) of
$of. Returns 1 for yes, 0 for no.

$dep and $of must already be added to the object.

=head2 is_manual($pkg)

Checks if $pkg is manually installed. Returns 1 for yes, 0 no.

=head2 exists($pkg)

Checks if $pkg is present in repo. Returns 1 for yes, 0 for no.

=head2 dependencies($pkg)

Returns list of packages that are a dependency of $pkg, according to the
database.

=head2 immediate_dependencies($pkg)

Returns list of packages that are an immediate dependency of $pkg, according to
the database. Does not return dependencies of those dependencies.

=head2 real_dependencies($pkg)

Returns list of packages that are a dependency of $pkg, according to the
SlackBuild repo. $pkg does not have to have been added previously.

=head2 real_immediate_dependencies($pkg)

Returns list of packages that are an immediate dependency of $pkg, according
to the SlackBuild repo. Does not return packages that are dependencies of those
dependencies. $pkg does not have to have been added previously.

=head2 unmanual($pkg)

Unset $pkg as manually installed. Returns 1 if successful, 0 if not.

=head2 write($path)

Write data file to $path.

=head1 AUTHOR

Written by Samuel Young E<lt>samyoung12788@gmail.comE<gt>.

=head1 BUGS

This module does not know how to handle circular dependencies. This should not
be a problem if you stick with the official SlackBuild repo. One should
exercise caution when using the depadd method, as it can easily introduce
circular dependencies.

Report bugs on my Codeberg, L<https://codeberg.org/1-1sam>.

=head1 COPYRIGHT

Copyright (C) 2024 Samuel Young

This program is free software; you can redistribute it and/or modify it under
the terms of either: the GNU General Public License as published by the Free
Software Foundation; or the Artistic License.

=head1 SEE ALSO

L<sbokeeper>

=cut
