use 5.016;
our $VERSION = '2.06';
sub write_data {
my $data = shift;
my $out = shift;
my $outstr = '';
open my $fh, '>', $out // \$outstr
or die sprintf "Failed to open %s for writing: $!\n", $out // 'in-memory scalar';
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 } '%%';
}
close $fh;
return $out // $outstr;
}
sub read_data {
my $file = shift;
my $blacklist = 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 '%%') {
$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}} =
grep { not exists $blacklist->{$_} }
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;
for my $p (keys %{$blacklist}) {
delete $data->{$p};
}
return $data;
}
sub new {
my $class = shift;
my $file = shift;
my $sbodir = shift;
my $blacklist = shift // {};
$blacklist->{'%README%'} = 1;
my $self = {
_data => {},
_sbodir => '',
_blacklist => $blacklist,
};
if ($file) {
$self->{_data} = read_data($file, $self->{_blacklist});
}
$self->{_sbodir} = $sbodir;
bless $self, $class;
return $self;
}
sub add {
my $self = shift;
my $pkgs = shift;
my $manual = shift;
my %added;
my $n = 0;
foreach my $p (@{$pkgs}) {
next if $self->blacklist($p);
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;
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);
for my $ad (@add) {
$added{$ad} = $n++ unless exists $added{$ad};
}
$added{$p} = $n++;
}
return sort { $added{$a} <=> $added{$b} } keys %added;
}
sub tack {
my $self = shift;
my $pkgs = shift;
my $manual = shift;
my @tack;
foreach my $p (@{$pkgs}) {
next if $self->blacklist($p);
unless ($self->exists($p)) {
die "$p does not exist in SlackBuild repo\n";
}
if (defined $self->{_data}->{$p} and $manual) {
$self->{_data}->{$p}->{Manual} = $manual;
push @tack, $p;
} else {
$self->{_data}->{$p} = {
Deps => [],
Manual => $manual,
};
push @tack, $p;
}
}
return @tack;
}
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}) {
next if $self->blacklist($d);
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;
return sort keys %{$self->{_data}};
}
sub missing {
my $self = shift;
my %missing;
foreach my $p ($self->packages) {
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;
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;
}
return
any { $self->is_dependency($pkg, $_) }
grep { $self->is_manual($_) }
$self->packages
;
}
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_immediate_dependency {
my $self = shift;
my $dep = shift;
my $of = shift;
foreach my $p (@{$self->{_data}->{$of}->{Deps}}) {
if ($p eq $dep) {
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 0 if $self->blacklist($pkg);
if (() = glob "$self->{_sbodir}/*/$pkg/$pkg.info") {
return 1;
} else {
return 0;
}
}
sub blacklist {
my $self = shift;
my $pkg = shift;
return exists $self->{_blacklist}->{$pkg};
}
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 { !$self->blacklist($_) } split /\s/, $depstr;
while (substr($l, -1) eq '\\') {
$l = readline $fh;
chomp $l;
($depstr) = $l =~ /(^.*)("|\\)/;
push @deps, grep { !$self->blacklist($_) } split(" ", $depstr);
}
last;
}
close $fh;
return sort @deps;
}
sub reverse_dependencies {
my $self = shift;
my $pkg = shift;
return grep {
$self->is_immediate_dependency($pkg, $_)
} $self->packages;
}
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;