view release on metacpan or  search on metacpan

URPM/Build.pm  view on Meta::CPAN

		#- make smart use of memory (no need to keep header in memory now).
		if ($options{callback}) {
		    $options{callback}->($urpm, $id, %options, (file => $_));
		} else {
			$pkg->pack_header;
		}

		# Olivier Thauvin <thauvin@aerov.jussieu.fr>
		# isn't this code better, but maybe it will break some tools:
		# $options{callback}->($urpm, $id, %options, (file => $_)) if ($options{callback});
		# $pkg->pack_header;
	    }

	    #- keep track of header associated (to avoid rereading rpm filename directly
	    #- if rereading has been made neccessary).
	    push @headers, $filename;
	}
    }
    @headers;
}

# DEPRECATED. ONLY USED BY MKCD
#
#- allow rereading of hdlist and clean.
sub unresolved_provides_clean {
    my ($urpm) = @_;
    $urpm->{depslist} = [];
    $urpm->{provides}{$_} = undef foreach keys %{$urpm->{provides} || {}};
}

# DEPRECATED. ONLY USED BY MKCD
#
#- read a list of headers (typically when building an hdlist when provides have
#- been cleaned).
#- parameters are :
#-   headers  : array containing all headers filenames to parse (mandatory)
#-   dir      : directory which contains headers (defaults to /tmp/.build_hdlist)
#-   callback : perl code to be called for each package read (defaults to pack_header)
sub parse_headers {
    my ($urpm, %options) = @_;
    my ($dir, $start, $id);

    $dir = $options{dir} || _get_tmp_dir();
    -d $dir or die "no directory $dir\n";

    $start = @{$urpm->{depslist} || []};
    foreach (@{$options{headers} || []}) {
	#- make smart use of memory (no need to keep header in memory now).
	($id, undef) = $urpm->parse_hdlist("$dir/$_", packing => !$options{callback});
	defined $id or die "bad header $dir/$_\n";
	$options{callback} and $options{callback}->($urpm, $id, %options);
    }
    defined $id ? ($start, $id) : @{[]};
}

# DEPRECATED. ONLY USED BY MKCD
#- compute dependencies, result in stored in info values of urpm.
#- operations are incremental, it is possible to read just one hdlist, compute
#- dependencies and read another hdlist, and again.
#- parameters are :
#-   callback : callback to relocate reference to package id.
sub compute_deps {
    my ($urpm, %options) = @_;
    my %propagated_weight = (
	basesystem => 10000,
	msec       => 20000,
	filesystem => 50000,
    );
    my ($locales_weight, $step_weight, $fixed_weight) = (-5000, 10000, $propagated_weight{basesystem});

    #- avoid recomputing already present infos, take care not to modify
    #- existing entries, as the array here is used instead of values of infos.
    my $start = @{$urpm->{deps} ||= []};
    my $end = $#{$urpm->{depslist} || []};

    #- check if something has to be done.
    $start > $end and return;

    #- keep track of prereqs.
    my %prereqs;

    #- take into account in which hdlist a package has been found.
    #- this can be done by an incremental take into account generation
    #- of depslist.ordered part corresponding to the hdlist.
    #- compute closed requires, do not take into account choices.
    foreach ($start .. $end) {
	my $pkg = $urpm->{depslist}[$_];

	my %required_packages;
	my @required_packages;
	my %requires;

	foreach ($pkg->requires) {
	    my ($n, $prereq) = /^([^\s\[]*)(\[\*\])?/;
	    $requires{$n} = $prereq && 1;
	}
	my @requires = keys %requires;

	while (my $req = shift @requires) {
	    $req =~ /^basesystem/ and next; #- never need to requires basesystem directly as always required! what a speed up!
	    my $treq = (
		$req =~ /^\d+$/ ? [ $req ]
		: $urpm->{provides}{$req} ? [ keys %{$urpm->{provides}{$req}} ]
		: [ ($req !~ /NOTFOUND_/ ? "NOTFOUND_" : "") . $req ]
	    );
	    if (@$treq > 1) {
		#- this is a choice, no closure need to be done here.
		push @required_packages, $treq;
	    } else {
		#- this could be nothing if the provides is a file not found.
		#- and this has been fixed above.
		foreach (@$treq) {
		    my $pkg_ = /^\d+$/ && $urpm->{depslist}[$_];
		    exists $required_packages{$_} and $pkg_ = undef;
		    $required_packages{$_} ||= $requires{$req}; $pkg_ or next;
		    foreach ($pkg_->requires_nosense) {
			exists $requires{$_} or push @requires, $_;
			$requires{$_} ||= $requires{$req};
		    }
		}
	    }