File Coverage

blib/lib/DPKG/Packages/Parser.pm

Criterion	Covered	Total	%
statement	14	14	100.0
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	19	19	100.0

package DPKG::Packages::Parser;

use v5.40;
use feature 'class';
no warnings 'experimental::class';

use Clone qw(clone);
use Carp qw(croak);

our $VERSION = '0.03';

class DPKG::Packages::Parser {
	field $file :param :reader = 'Packages';
	field $fh :param :reader = undef;

	field %entries = ();

	method parse(@fields) {
		if(-r $file) {
			open(my $f, '<', $file) or die "Cannot read $file\n";
			$self->_parse_from_filehandle($f, @fields);
			return 1;
		} elsif(defined($fh)) {
			$self->_parse_from_filehandle($fh, @fields);
			return 1;
		} else {
			croak("DPKG::Packages::Parser - $file is not a readable file");
		}
	}

	method _parse_from_filehandle($fh, @fields) {
		my %f = ();
		my @array_fields = qw(Tag Depends Pre-Depends Replaces Provides Breaks Enhances Conflicts Recommends Suggests);
		if(@fields) {
			unshift @fields, 'Package' if ! grep { 'Packages' eq $_ } @fields;
			$f{$_} = 1 foreach(@fields);
			@array_fields = grep { $f{$_} } @array_fields; # Only keep the ones that are requested by the User
		}
		my %entry = ();
		my $last_key; # 'Tag' is multi-line, I don't know why this is the only field which does this... but we need to remember th^i
		while(<$fh>) {
			chomp;
			if(!$_) { # Empty line == post processing of entry (we've seen all its lines)
				# Yeah, good luck understanding this mess. We loop through the array fields to split it based on ', '. Then if we're dealing with a tag but with a list that contains package names, we have to parse each package name. There's a further edge case where there's an OR statement (signified by '|') between packages that we also deal with.
				map { $entry{$_} = $_ eq 'Tag' ? [ split(', ', $entry{$_}) ] : [ map { index($_,'|') >= 0 ? [ map { $self->_parse_package_str($_) } split(' \| ', $_) ] : $self->_parse_package_str($_) } split(', ', $entry{$_}) ] if defined($entry{$_}) } @array_fields;
				$entries{$entry{Package}} = clone(\%entry);
				%entry = ();
			} else {
				# if statement with side-effects: the defined() condition needs to be first because we need to set $last_key every time we match a line.
				# We check in the if-condition if we are interested in this line or not by extracting the field name of this line (and only that, not the value). We only extract the value if it's a line of interest.
				if(index($_, ' ') != 0 && (defined($f{$last_key = substr($_, 0, index($_, ':'))}) || !@fields)) {
					$entry{$last_key} = substr($_, index($_, ':') + 2);
				} elsif(!@fields || $f{$last_key}) {
					$entry{$last_key} .= $_
				}
			}
		}
		close($fh);
	}

	method _parse_package_str($s) {
		my @x = split(' ', $s);
		my ($name, $arch) = split(':', $x[0]);
		my $op = $x[1] ? substr($x[1], 1) : undef;
		chop($x[2]) if $x[2];
		my $version = $x[2] ? $x[2] : undef;
		return {name => $name, op => $op, version => $version, arch => $arch};
	}

	method get_package($name) {
		return defined($entries{$name}) ? $entries{$name} : undef;
	}
}

1;
__END__