1 # -*- Mode: cperl; coding: utf-8; cperl-indent-level: 4 -*-
3 package CPAN::Queue::Item;
5 # CPAN::Queue::Item::new ;
8 my $self = bless { @attr }, $class;
17 # r => requires, b => build_requires, c => commandline
25 # One use of the queue is to determine if we should or shouldn't
26 # announce the availability of a new CPAN module
28 # Now we try to use it for dependency tracking. For that to happen
29 # we need to draw a dependency tree and do the leaves first. This can
30 # easily be reached by running CPAN.pm recursively, but we don't want
31 # to waste memory and run into deep recursion. So what we can do is
34 # CPAN::Queue is the package where the queue is maintained. Dependencies
35 # often have high priority and must be brought to the head of the queue,
36 # possibly by jumping the queue if they are already there. My first code
37 # attempt tried to be extremely correct. Whenever a module needed
38 # immediate treatment, I either unshifted it to the front of the queue,
39 # or, if it was already in the queue, I spliced and let it bypass the
40 # others. This became a too correct model that made it impossible to put
41 # an item more than once into the queue. Why would you need that? Well,
42 # you need temporary duplicates as the manager of the queue is a loop
45 # (1) looks at the first item in the queue without shifting it off
47 # (2) cares for the item
49 # (3) removes the item from the queue, *even if its agenda failed and
50 # even if the item isn't the first in the queue anymore* (that way
51 # protecting against never ending queues)
53 # So if an item has prerequisites, the installation fails now, but we
54 # want to retry later. That's easy if we have it twice in the queue.
56 # I also expect insane dependency situations where an item gets more
57 # than two lives in the queue. Simplest example is triggered by 'install
58 # Foo Foo Foo'. People make this kind of mistakes and I don't want to
59 # get in the way. I wanted the queue manager to be a dumb servant, not
60 # one that knows everything.
62 # Who would I tell in this model that the user wants to be asked before
63 # processing? I can't attach that information to the module object,
64 # because not modules are installed but distributions. So I'd have to
65 # tell the distribution object that it should ask the user before
66 # processing. Where would the question be triggered then? Most probably
67 # in CPAN::Distribution::rematein.
69 use vars qw{ @All $VERSION };
70 $VERSION = sprintf "%.6f", substr(q$Rev: 2212 $,4)/1000000 + 5.4;
72 # CPAN::Queue::queue_item ;
74 my($class,@attr) = @_;
75 my $item = "$class\::Item"->new(@attr);
80 # CPAN::Queue::qpush ;
84 CPAN->debug(sprintf("in new All[%s]",
85 join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All),
89 # CPAN::Queue::first ;
95 # CPAN::Queue::delete_first ;
97 my($class,$what) = @_;
99 for my $i (0..$#All) {
100 if ( $All[$i]->{qmod} eq $what ) {
107 # CPAN::Queue::jumpqueue ;
111 CPAN->debug(sprintf("before jumpqueue All[%s] what[%s]",
113 map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All, @what
115 unless (defined $what[0]{reqtype}) {
116 # apparently it was not the Shell that sent us this enquiry,
117 # treat it as commandline
118 $what[0]{reqtype} = "c";
120 my $inherit_reqtype = $what[0]{reqtype} =~ /^(c|r)$/ ? "r" : "b";
121 WHAT: for my $what_tuple (@what) {
122 my($what,$reqtype) = @$what_tuple{qw(qmod reqtype)};
125 $inherit_reqtype eq "b"
130 for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
131 # CPAN->debug("i[$i]this[$All[$i]{qmod}]what[$what]") if $CPAN::DEBUG;
132 if ($All[$i]{qmod} eq $what) {
135 die "PANIC: object[$what] 50 instances on the queue, looks like ".
136 "some recursiveness has hit";
137 } elsif ($jumped > 25) { # one's OK if e.g. just processing
138 # now; more are OK if user typed
140 my $sleep = sprintf "%.1f", $jumped/10;
141 $CPAN::Frontend->mywarn(
142 qq{Warning: Object [$what] queued $jumped times, sleeping $sleep secs!\n}
144 $CPAN::Frontend->mysleep($sleep);
149 my $obj = "$class\::Item"->new(
155 CPAN->debug(sprintf("after jumpqueue All[%s]",
156 join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
160 # CPAN::Queue::exists ;
162 my($self,$what) = @_;
163 my @all = map { $_->{qmod} } @All;
164 my $exists = grep { $_->{qmod} eq $what } @All;
165 # warn "in exists what[$what] all[@all] exists[$exists]";
169 # CPAN::Queue::delete ;
172 @All = grep { $_->{qmod} ne $mod } @All;
173 CPAN->debug(sprintf("after delete mod[%s] All[%s]",
175 join("",map {sprintf " %s\[%s]\n",$_->{qmod},$_->{reqtype}} @All)
179 # CPAN::Queue::nullify_queue ;
190 This program is free software; you can redistribute it and/or
191 modify it under the same terms as Perl itself.