1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
5 # One use of the queue is to determine if we should or shouldn't
6 # announce the availability of a new CPAN module
8 # Now we try to use it for dependency tracking. For that to happen
9 # we need to draw a dependency tree and do the leaves first. This can
10 # easily be reached by running CPAN.pm recursively, but we don't want
11 # to waste memory and run into deep recursion. So what we can do is
14 # CPAN::Queue is the package where the queue is maintained. Dependencies
15 # often have high priority and must be brought to the head of the queue,
16 # possibly by jumping the queue if they are already there. My first code
17 # attempt tried to be extremely correct. Whenever a module needed
18 # immediate treatment, I either unshifted it to the front of the queue,
19 # or, if it was already in the queue, I spliced and let it bypass the
20 # others. This became a too correct model that made it impossible to put
21 # an item more than once into the queue. Why would you need that? Well,
22 # you need temporary duplicates as the manager of the queue is a loop
25 # (1) looks at the first item in the queue without shifting it off
27 # (2) cares for the item
29 # (3) removes the item from the queue, *even if its agenda failed and
30 # even if the item isn't the first in the queue anymore* (that way
31 # protecting against never ending queues)
33 # So if an item has prerequisites, the installation fails now, but we
34 # want to retry later. That's easy if we have it twice in the queue.
36 # I also expect insane dependency situations where an item gets more
37 # than two lives in the queue. Simplest example is triggered by 'install
38 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
39 # get in the way. I wanted the queue manager to be a dumb servant, not
40 # one that knows everything.
42 # Who would I tell in this model that the user wants to be asked before
43 # processing? I can't attach that information to the module object,
44 # because not modules are installed but distributions. So I'd have to
45 # tell the distribution object that it should ask the user before
46 # processing. Where would the question be triggered then? Most probably
47 # in CPAN::Distribution::rematein.
48 # Hope that makes sense, my head is a bit off:-) -- AK
50 use vars qw{ @All $VERSION };
51 $VERSION = sprintf "%.6f", substr(q$Rev: 1704 $,4)/1000000 + 5.4;
55 my($class,@attr) = @_;
56 my $self = bless { @attr }, $class;
58 CPAN->debug(sprintf("in new All[%s]",
59 join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
64 # CPAN::Queue::first ;
75 # r => requires, b => build_requires, c => commandline
81 # CPAN::Queue::delete_first ;
83 my($class,$what) = @_;
85 for my $i (0..$#All) {
86 if ( $All[$i]->{qmod} eq $what ) {
93 # CPAN::Queue::jumpqueue ;
97 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
98 join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
99 join("",map {sprintf " %s\[%s]",$_->[0],$_->[1]} @what)
101 unless (defined $what[0][1]) {
102 # apparently it was not the Shell that sent us this enquiry,
103 # treat it as commandline
106 my $inherit_reqtype = $what[0][1] =~ /^(c|r)$/ ? "r" : "b";
107 WHAT: for my $what_tuple (@what) {
108 my($what,$reqtype) = @$what_tuple;
111 $inherit_reqtype eq "b"
116 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
117 # CPAN->debug("i[$i]this[$All[$i]{qmod}]what[$what]") if $CPAN::DEBUG;
118 if ($All[$i]{qmod} eq $what){
120 if ($jumped > 25) { # one's OK if e.g. just processing
121 # now; more are OK if user typed
123 my $sleep = sprintf "%.1f", $jumped/10;
124 $CPAN::Frontend->mywarn(
125 qq{Warning: Object [$what] queued $jumped times, sleeping $sleep secs!\n}
127 $CPAN::Frontend->mysleep($sleep);
138 CPAN->debug(sprintf("after jumpqueue All[%s]",
139 join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
143 # CPAN::Queue::exists ;
145 my($self,$what) = @_;
146 my @all = map { $_->{qmod} } @All;
147 my $exists = grep { $_->{qmod} eq $what } @All;
148 # warn "in exists what[$what] all[@all] exists[$exists]";
152 # CPAN::Queue::delete ;
155 @All = grep { $_->{qmod} ne $mod } @All;
156 CPAN->debug(sprintf("after delete mod[%s] All[%s]",
158 join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
162 # CPAN::Queue::nullify_queue ;
173 This program is free software; you can redistribute it and/or
174 modify it under the same terms as Perl itself.