Evaluating perl code (e.g. via "eval" or "do 'file'") causes
the code to be compiled into an internal format and then,
provided there was no error in the compilation, executed.
-Code evaulated in a compartment compiles subject to the
-compartment's operator mask. Attempting to evaulate code in a
+Code evaluated in a compartment compiles subject to the
+compartment's operator mask. Attempting to evaluate code in a
compartment which contains a masked operator will cause the
compilation to fail with an error. The code will not be executed.
=head1 DESCRIPTION
-Since the ops pragma currently has an irreversable global effect, it is
+Since the ops pragma currently has an irreversible global effect, it is
only of significant practical use with the C<-M> option on the command line.
See the L<Opcode> module for information about opcodes, optags, opmasks
thus (presumably) defining the needed subroutine. AUTOLOAD will then
C<goto> the newly defined subroutine.
-Once this process completes for a given funtion, it is defined, so
+Once this process completes for a given function, it is defined, so
future calls to the subroutine will bypass the AUTOLOAD mechanism.
=head2 Subroutine Stubs
handle multiple packages in a file.
B<AutoLoader> only reads code as it is requested, and in many cases
-should be faster, but requires a machanism like B<AutoSplit> be used to
+should be faster, but requires a mechanism like B<AutoSplit> be used to
create the individual files. L<ExtUtils::MakeMaker> will invoke
B<AutoSplit> automatically if B<AutoLoader> is used in a module source
file.
independent of the others, this allows you to save the state of the
script and restore it later.
-For example, using the object oriented style, here is now you create
+For example, using the object oriented style, here is how you create
a simple "Hello World" HTML page:
- #!/usr/local/bin/pelr
+ #!/usr/local/bin/perl -w
use CGI; # load CGI routines
$q = new CGI; # create new CGI object
print $q->header, # create the HTTP header
dash. If a dash is present in the first argument, CGI.pm assumes
dashes for the subsequent ones.
-You don't have to use the hyphen at allif you don't want to. After
+You don't have to use the hyphen at all if you don't want to. After
creating a CGI object, call the B<use_named_parameters()> method with
a nonzero value. This will tell CGI.pm that you intend to use named
parameters exclusively:
$zipcode = param('zipcode');
More frequently, you'll import common sets of functions by referring
-to the gropus by name. All function sets are preceded with a ":"
+to the groups by name. All function sets are preceded with a ":"
character as in ":html3" (for tags defined in the HTML 3 standard).
Here is a list of the function sets you can import:
Microsoft comes out with a new tag called <GRADIENT> (which causes the
user's desktop to be flooded with a rotating gradient fill until his
machine reboots). You don't need to wait for a new version of CGI.pm
-to start using it immeidately:
+to start using it immediately:
use CGI qw/:standard :html3 gradient/;
print gradient({-start=>'red',-end=>'blue'});
rather than deferred to later. This is useful for scripts that run
for an extended period of time under FastCGI or mod_perl, and for
those destined to be crunched by Malcom Beattie's Perl compiler. Use
-it in conjunction with the methods or method familes you plan to use.
+it in conjunction with the methods or method families you plan to use.
use CGI qw(-compile :standard :html3);
this allows you to specify different source files for different dialects
of JavaScript. Example:
- print $q->start_html(-title=>'The Riddle of the Sphinx',
- -script=>[
- { -language => 'JavaScript1.0',
- -src => '/javascript/utilities10.js'
+ print $q->start_html(-title=>'The Riddle of the Sphinx',
+ -script=>[
+ { -language => 'JavaScript1.0',
+ -src => '/javascript/utilities10.js'
},
- { -language => 'JavaScript1.1',
- -src => '/javascript/utilities11.js'
+ { -language => 'JavaScript1.1',
+ -src => '/javascript/utilities11.js'
},
- { -language => 'JavaScript1.2',
- -src => '/javascript/utilities12.js'
+ { -language => 'JavaScript1.2',
+ -src => '/javascript/utilities12.js'
},
- { -language => 'JavaScript28.2',
- -src => '/javascript/utilities219.js'
+ { -language => 'JavaScript28.2',
+ -src => '/javascript/utilities219.js'
}
]
);
print $q->blockquote(
"Many years ago on the island of",
$q->a({href=>"http://crete.org/"},"Crete"),
- "there lived a minotaur named",
+ "there lived a Minotaur named",
$q->strong("Fred."),
),
$q->hr;
Prior to CGI.pm version 2.41, providing an empty ('') string as an
attribute argument was the same as providing undef. However, this has
-changed in order to accomodate those who want to create tags of the form
+changed in order to accommodate those who want to create tags of the form
<IMG ALT="">. The difference is shown in these two pieces of code:
CODE RESULT
can use the B<-rowheader> and B<-colheader> parameters. Both
of these accept a pointer to an array of headings to use.
The headings are just decorative. They don't reorganize the
-interpetation of the radio buttons -- they're still a single named
+interpretation of the radio buttons -- they're still a single named
unit.
=back
$Frontend $Defaultsite
};
-$VERSION = '1.40';
+$VERSION = '1.44_54';
-# $Id: CPAN.pm,v 1.239 1998/07/24 16:37:04 k Exp $
+# $Id: CPAN.pm,v 1.250 1999/01/14 12:26:13 k Exp $
# only used during development:
$Revision = "";
-# $Revision = "[".substr(q$Revision: 1.239 $, 10)."]";
+# $Revision = "[".substr(q$Revision: 1.250 $, 10)."]";
use Carp ();
use Config ();
$CPAN::Frontend->mywarn(qq{
Commands starting with "w" require CPAN::WAIT to be installed.
Please consider installing CPAN::WAIT to use the fulltext index.
-For this you just need to type
+For this you just need to type
install CPAN::WAIT
});
}
if (defined($name=$INC{"$pkg.pm"}))
{
$name =~ s|^(.*)$pkg\.pm$|$1auto/$pkg/$func.al|;
- $name = undef unless (-r $name);
+ $name = undef unless (-r $name);
}
unless (defined $name)
{
*$autoload = sub {};
$ok = 1;
} else {
- if ($name =~ s/(\w{12,})\.al$/substr($1,0,11).".al"/e){
+ if ($name =~ s{(\w{12,})\.al$}{substr($1,0,11).".al"}e){
eval {local $SIG{__DIE__};require $name};
}
if ($@){
package CPAN::Queue;
# currently only used to determine if we should or shouldn't announce
# the availability of a new CPAN module
+
+# but now we try to use it for dependency tracking. For that to happen
+# we need to draw a dependency tree and do the leaves first. This can
+# easily be reached by running CPAN.pm recursively, but we don't want
+# to waste memory and run into deep recursion. So what we can do is
+# this: run the queue as the user suggested. When a dependency is
+# detected check if it is in the queue. If so, rearrange, otherwise
+# unshift it on the queue.
+
+use vars qw{ @All };
+
sub new {
my($class,$mod) = @_;
- # warn "Queue object for mod[$mod]";
- bless {mod => $mod}, $class;
+ my $self = bless {mod => $mod}, $class;
+ push @All, $self;
+ # my @all = map { $_->{mod} } @All;
+ # warn "Adding Queue object for mod[$mod] all[@all]";
+ return $self;
+
+}
+
+sub first {
+ my $obj = $All[0];
+ $obj->{mod};
+}
+
+sub delete_first {
+ my($class,$what) = @_;
+ my $i;
+ for my $i (0..$#All) {
+ if ( $All[$i]->{mod} eq $what ) {
+ splice @All, $i, 1;
+ return;
+ }
+ }
+}
+
+sub jumpqueue {
+ my $class = shift;
+ my @what = @_;
+ my $obj;
+ WHAT: for my $what (reverse @what) {
+ my $jumped = 0;
+ for (my $i=0; $i<$#All;$i++) { #prevent deep recursion
+ if ($All[$i]->{mod} eq $what){
+ $jumped++;
+ if ($jumped > 100) { # one's OK if e.g. just processing now;
+ # more are OK if user typed it several
+ # times
+ $CPAN::Frontend->mywarn(
+qq{Object [$what] queued more than 100 times, ignoring}
+ );
+ next WHAT;
+ }
+ }
+ }
+ my $obj = bless { mod => $what }, $class;
+ unshift @All, $obj;
+ }
+}
+
+sub exists {
+ my($self,$what) = @_;
+ my @all = map { $_->{mod} } @All;
+ my $exists = grep { $_->{mod} eq $what } @All;
+ # warn "Checking exists in Queue object for mod[$what] all[@all] exists[$exists]";
+ $exists;
+}
+
+sub delete {
+ my($self,$mod) = @_;
+ @All = grep { $_->{mod} ne $mod } @All;
+ # my @all = map { $_->{mod} } @All;
+ # warn "Deleting Queue object for mod[$mod] all[@all]";
}
package CPAN;
sub {
$File::Find::prune++ if $CPAN::Signal;
return if -l $_;
- $Du += -s _;
+ $Du += (-s _); # parens to help cperl-mode
},
$dir
);
my $self = {
ID => $CPAN::Config->{'build_dir'},
MAX => $CPAN::Config->{'build_cache'},
+ SCAN => $CPAN::Config->{'scan_cache'} || 'atstart',
DU => 0
};
File::Path::mkpath($self->{ID});
my $dh = DirHandle->new($self->{ID});
bless $self, $class;
- my $e;
+ $self->scan_cache;
+ $t2 = time;
+ $debug .= "timing of CacheMgr->new: ".($t2 - $time);
+ $time = $t2;
+ CPAN->debug($debug) if $CPAN::DEBUG;
+ $self;
+}
+
+#-> sub CPAN::CacheMgr::scan_cache ;
+sub scan_cache {
+ my $self = shift;
+ return if $self->{SCAN} eq 'never';
+ $CPAN::Frontend->mydie("Unknown scan_cache argument: $self->{SCAN}")
+ unless $self->{SCAN} eq 'atstart';
$CPAN::Frontend->myprint(
sprintf("Scanning cache %s for sizes\n",
$self->{ID}));
+ my $e;
for $e ($self->entries($self->{ID})) {
next if $e eq ".." || $e eq ".";
$self->disk_usage($e);
return if $CPAN::Signal;
}
$self->tidyup;
- $t2 = time;
- $debug .= "timing of CacheMgr->new: ".($t2 - $time);
- $time = $t2;
- CPAN->debug($debug) if $CPAN::DEBUG;
- $self;
}
package CPAN::Debug;
EOF
$msg ||= "\n";
my($fh) = FileHandle->new;
+ rename $configpm, "$configpm~" if -f $configpm;
open $fh, ">$configpm" or warn "Couldn't open >$configpm: $!";
$fh->print(qq[$msg\$CPAN::Config = \{\n]);
foreach (sort keys %$CPAN::Config) {
sub load {
my($self) = shift;
my(@miss);
+ use Carp;
eval {require CPAN::Config;}; # We eval because of some
# MakeMaker problems
unless ($dot_cpan++){
}
}
local($") = ", ";
- $CPAN::Frontend->myprint(qq{
+ $CPAN::Frontend->myprint(<<END) if $redo && ! $theycalled;
We have to reconfigure CPAN.pm due to following uninitialized parameters:
@miss
-}) if $redo && ! $theycalled;
+END
$CPAN::Frontend->myprint(qq{
$configpm initialized.
});
sub not_loaded {
my(@miss);
for (qw(
- cpan_home keep_source_where build_dir build_cache index_expire
- gzip tar unzip make pager makepl_arg make_arg make_install_arg
- urllist inhibit_startup_message ftp_proxy http_proxy no_proxy
+ cpan_home keep_source_where build_dir build_cache scan_cache
+ index_expire gzip tar unzip make pager makepl_arg make_arg
+ make_install_arg urllist inhibit_startup_message
+ ftp_proxy http_proxy no_proxy prerequisites_policy
)) {
push @miss, $_ unless defined $CPAN::Config->{$_};
}
#-> sub CPAN::Shell::d ;
sub d { $CPAN::Frontend->myprint(shift->format_result('Distribution',@_));}
#-> sub CPAN::Shell::m ;
-sub m { $CPAN::Frontend->myprint(shift->format_result('Module',@_));}
+sub m { # emacs confused here }; sub mimimimimi { # emacs in sync here
+ $CPAN::Frontend->myprint(shift->format_result('Module',@_));
+}
#-> sub CPAN::Shell::i ;
sub i {
CPAN->debug("pragma[$pragma]meth[$meth] some[@some]") if $CPAN::DEBUG;
my($s,@s);
foreach $s (@some) {
+ CPAN::Queue->new($s);
+ }
+ while ($s = CPAN::Queue->first) {
my $obj;
if (ref $s) {
$obj = $s;
} elsif ($s =~ m|/|) { # looks like a file
$obj = $CPAN::META->instance('CPAN::Distribution',$s);
} elsif ($s =~ m|^Bundle::|) {
- $CPAN::META->{'CPAN::Queue'}{$s} ||= CPAN::Queue->new($s);
$obj = $CPAN::META->instance('CPAN::Bundle',$s);
} else {
- $CPAN::META->{'CPAN::Queue'}{$s} ||= CPAN::Queue->new($s);
$obj = $CPAN::META->instance('CPAN::Module',$s)
if $CPAN::META->exists('CPAN::Module',$s);
}
if (ref $obj) {
CPAN->debug(
- qq{pragma[$pragma] meth[$meth] obj[$obj] as_string\[}.
+ qq{pragma[$pragma]meth[$meth]obj[$obj]as_string\[}.
$obj->as_string.
qq{\]}
) if $CPAN::DEBUG;
if ($]>=5.00303 && $obj->can('called_for')) {
$obj->called_for($s);
}
- $obj->$meth();
+ CPAN::Queue->delete($s) if $obj->$meth(); # if it is more
+ # than once in
+ # the queue
} elsif ($CPAN::META->exists('CPAN::Author',$s)) {
$obj = $CPAN::META->instance('CPAN::Author',$s);
$CPAN::Frontend->myprint(
" ;-)\n"
);
} else {
- $CPAN::Frontend->myprint(qq{Warning: Cannot $meth $s, don\'t know what it is.
+ $CPAN::Frontend
+ ->myprint(qq{Warning: Cannot $meth $s, }.
+ qq{don\'t know what it is.
Try the command
i /$s/
to find objects with similar identifiers.
});
}
+ CPAN::Queue->delete_first($s);
}
}
}
# If more accuracy is wanted/needed, Chris Leach sent me this patch...
-
+
# leach,> *** /install/perl/live/lib/CPAN.pm- Wed Sep 24 13:08:48 1997
# leach,> --- /tmp/cp Wed Sep 24 13:26:40 1997
# leach,> ***************
@reordered =
sort {
(substr($CPAN::Config->{urllist}[$b],0,4) eq "file")
- <=>
+ <=>
(substr($CPAN::Config->{urllist}[$a],0,4) eq "file")
or
defined($Thesite)
$CPAN::Frontend->myprint("Fetching with LWP:
$url
");
+ unless ($Ua) {
+ require LWP::UserAgent;
+ $Ua = LWP::UserAgent->new;
+ }
my $res = $Ua->mirror($url, $aslocal);
if ($res->is_success) {
$Thesite = $i;
# gave us a socksified (or other) ftp program...
my($i);
- my($devnull) = $CPAN::Config->{devnull} || "";
+ my($devnull) = $CPAN::Config->{devnull} || "";
# < /dev/null ";
my($aslocal_dir) = File::Basename::dirname($aslocal);
File::Path::mkpath($aslocal_dir);
CPAN::Tarzip->gzip($aslocal_uncompressed,
"$aslocal_uncompressed.gz");
}
- $Thesite = $i;
- return $aslocal;
}
+ $Thesite = $i;
+ return $aslocal;
} elsif ($url !~ /\.gz$/) {
unlink $aslocal_uncompressed if
-f $aslocal_uncompressed && -s _ == 0;
Subprocess "|$command"
returned status $estatus (wstat $wstatus)
}) if $wstatus;
-
}
# find2perl needs modularization, too, all the following is stolen
while (<FH>) {
chomp;
my($userid,$fullname,$email) =
- /alias\s+(\S+)\s+\"([^\"\<]+)\s+<([^\>]+)\>\"/;
+ m/alias\s+(\S+)\s+\"([^\"\<]+)\s+\<([^\>]+)\>\"/;
next unless $userid && $fullname && $email;
# instantiate an author object
# if it is a bundle, instatiate a bundle object
my($bundle,$id,$userid);
-
+
if ($mod eq 'CPAN' &&
! (
- $CPAN::META->exists('CPAN::Queue','Bundle::CPAN') ||
- $CPAN::META->exists('CPAN::Queue','CPAN')
+ CPAN::Queue->exists('Bundle::CPAN') ||
+ CPAN::Queue->exists('CPAN')
)
) {
local($^W)= 0;
#-> sub CPAN::Distribution::force ;
sub force {
- my($self) = @_;
- $self->{'force_update'}++;
- delete $self->{'MD5_STATUS'};
- delete $self->{'archived'};
- delete $self->{'build_dir'};
- delete $self->{'localfile'};
- delete $self->{'make'};
- delete $self->{'install'};
- delete $self->{'unwrapped'};
- delete $self->{'writemakefile'};
+ my($self) = @_;
+ $self->{'force_update'}++;
+ for my $att (qw(
+ MD5_STATUS archived build_dir localfile make install unwrapped
+ writemakefile have_sponsored
+ )) {
+ delete $self->{$att};
+ }
}
sub isa_perl {
$self->{writemakefile} = "YES";
}
return if $CPAN::Signal;
+ if (my @prereq = $self->needs_prereq){
+ my $id = $self->id;
+ $CPAN::Frontend->myprint("---- Dependencies detected ".
+ "during [$id] -----\n");
+
+ for my $p (@prereq) {
+ $CPAN::Frontend->myprint(" $p\n");
+ }
+ sleep 2;
+ my $follow = 0;
+ if ($CPAN::Config->{prerequisites_policy} eq "follow") {
+ $follow = 1;
+ } elsif ($CPAN::Config->{prerequisites_policy} eq "ask") {
+ require ExtUtils::MakeMaker;
+ my $answer = ExtUtils::MakeMaker::prompt(
+"Shall I follow them and prepend them to the queue
+of modules we are processing right now?", "yes");
+ $follow = $answer =~ /^\s*y/i;
+ }
+ if ($follow) {
+ CPAN::Queue->jumpqueue(@prereq,$id); # requeue yourself
+ return;
+ }
+ }
$system = join " ", $CPAN::Config->{'make'}, $CPAN::Config->{make_arg};
if (system($system) == 0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
}
}
+#-> sub CPAN::Distribution::needs_prereq ;
+sub needs_prereq {
+ my($self) = @_;
+ return unless -f "Makefile"; # we cannot say much
+ my $fh = FileHandle->new("<Makefile") or
+ $CPAN::Frontend->mydie("Couldn't open Makefile: $!");
+ local($/) = "\n";
+ my($v);
+ while (<$fh>) {
+ last if ($v) = m| ^ \# \s+ ( \d+\.\d+ ) .* Revision: |x;
+ }
+
+ my(@p,@need);
+ if (1) { # probably all versions of MakeMaker ever so far
+ while (<$fh>) {
+ last if /MakeMaker post_initialize section/;
+ my($p) = m{^[\#]
+ \s+PREREQ_PM\s+=>\s+(.+)
+ }x;
+ next unless $p;
+ # warn "Found prereq expr[$p]";
+
+ while ( $p =~ m/(?:\s)([\w\:]+)=>q\[.*?\],?/g ){
+ push @p, $1;
+ }
+ last;
+ }
+ } else { # MakeMaker after a patch I suggested. Let's wait and see
+ while (<$fh>) {
+ last if /MakeMaker post_initialize section/;
+ my($p) = m|\# prerequisite (\S+).+not found|;
+ next unless $p;
+ push @p, $p;
+ }
+ }
+ for my $p (@p) {
+ unless ($CPAN::META->instance("CPAN::Module",$p)->inst_file){
+ if ($self->{'have_sponsored'}{$p}++) {
+ # We have already sponsored it and for some reason it's still
+ # not available. So we do nothing. Or what should we do?
+ } else {
+ # warn "----- Protegere $p -----";
+ push @need, $p;
+ # CPAN::Queue->jumpqueue($p);
+ # $ret++;
+ }
+ }
+ }
+ return @need;
+}
+
#-> sub CPAN::Distribution::test ;
sub test {
my($self) = @_;
if $CPAN::DEBUG;
my $system = join(" ", $CPAN::Config->{'make'},
"install", $CPAN::Config->{make_install_arg});
- my($pipe) = FileHandle->new("$system 2>&1 |");
+ my($stderr) = $^O =~ /Win/i ? "" : " 2>&1 ";
+ my($pipe) = FileHandle->new("$system $stderr |");
my($makeout) = "";
while (<$pipe>){
$CPAN::Frontend->myprint($_);
$pipe->close;
if ($?==0) {
$CPAN::Frontend->myprint(" $system -- OK\n");
- $self->{'install'} = "YES";
+ return $self->{'install'} = "YES";
} else {
$self->{'install'} = "NO";
$CPAN::Frontend->myprint(" $system -- NOT OK\n");
### The following two lines let CPAN.pm become Bundle/CPAN.pm :-(
### my $bu = MM->catfile($where,$what);
### return $bu if -f $bu;
- my $bu;
my $manifest = MM->catfile($where,"MANIFEST");
unless (-f $manifest) {
require ExtUtils::Manifest;
my $fh = FileHandle->new($manifest)
or Carp::croak("Couldn't open $manifest: $!");
local($/) = "\n";
+ my $what2 = $what;
+ $what2 =~ s|Bundle/||;
+ my $bu;
while (<$fh>) {
next if /^\s*\#/;
my($file) = /(\S+)/;
if ($file =~ m|\Q$what\E$|) {
$bu = $file;
- return MM->catfile($where,$bu);
- } elsif ($what =~ s|Bundle/||) { # retry if she managed to
- # have no Bundle directory
- if ($file =~ m|\Q$what\E$|) {
- $bu = $file;
- return MM->catfile($where,$bu);
- }
+ # return MM->catfile($where,$bu); # bad
+ last;
}
+ # retry if she managed to
+ # have no Bundle directory
+ $bu = $file if $file =~ m|\Q$what2\E$|;
}
+ return MM->catfile($where, $bu) if $bu;
Carp::croak("Couldn't find a Bundle file in $where");
}
my($id) = $self->id;
Carp::croak "Can't $meth $id, don't have an associated bundle file. :-(\n"
unless $self->inst_file || $self->{CPAN_FILE};
- my($s);
+ my($s,%fail);
for $s ($self->contains) {
my($type) = $s =~ m|/| ? 'CPAN::Distribution' :
$s =~ m|^Bundle::| ? 'CPAN::Bundle' : 'CPAN::Module';
});
sleep 3;
}
- $CPAN::META->instance($type,$s)->$meth();
+ # possibly noisy action:
+ my $obj = $CPAN::META->instance($type,$s);
+ $obj->$meth();
+ my $success = $obj->can("uptodate") ? $obj->uptodate : 0;
+ $success ||= $obj->{'install'} && $obj->{'install'} eq "YES";
+ $fail{$s} = 1 unless $success;
+ }
+ # recap with less noise
+ if ( $meth eq "install") {
+ if (%fail) {
+ $CPAN::Frontend->myprint(qq{\nBundle summary: }.
+ qq{The following items seem to }.
+ qq{have had installation problems:\n});
+ for $s ($self->contains) {
+ $CPAN::Frontend->myprint( "$s " ) if $fail{$s};
+ }
+ $CPAN::Frontend->myprint(qq{\n});
+ } else {
+ $self->{'install'} = 'YES';
+ }
}
}
sub install {
my $self = shift;
$self->rematein('install',@_);
- $CPAN::META->delete('CPAN::Queue',$self->id);
}
#-> sub CPAN::Bundle::clean ;
sub clean { shift->rematein('clean',@_); }
#-> sub CPAN::Module::cpan_version ;
sub cpan_version {
my $self = shift;
- $self->{'CPAN_VERSION'} = 'undef'
+ $self->{'CPAN_VERSION'} = 'undef'
unless defined $self->{'CPAN_VERSION'}; # I believe this is
# always a bug in the
# index and should be
sub make { shift->rematein('make') }
#-> sub CPAN::Module::test ;
sub test { shift->rematein('test') }
-#-> sub CPAN::Module::install ;
-sub install {
+#-> sub CPAN::Module::uptodate ;
+sub uptodate {
my($self) = @_;
- my($doit) = 0;
my($latest) = $self->cpan_version;
$latest ||= 0;
my($inst_file) = $self->inst_file;
if ($inst_file
&&
$have >= $latest
- &&
- not exists $self->{'force_update'}
) {
- $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
- } else {
- $doit = 1;
+ return 1;
}
}
+ return;
+}
+#-> sub CPAN::Module::install ;
+sub install {
+ my($self) = @_;
+ my($doit) = 0;
+ if ($self->uptodate
+ &&
+ not exists $self->{'force_update'}
+ ) {
+ $CPAN::Frontend->myprint( $self->id. " is up to date.\n");
+ } else {
+ $doit = 1;
+ }
$self->rematein('install') if $doit;
- $CPAN::META->delete('CPAN::Queue',$self->id);
}
#-> sub CPAN::Module::clean ;
sub clean { shift->rematein('clean') }
$fhw->close;
return 1;
} else {
- system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
+ system("$CPAN::Config->{'gzip'} -c $read > $write")==0;
}
}
if (MM->maybe_command($CPAN::Config->{'gzip'})
&&
MM->maybe_command($CPAN::Config->{'tar'})) {
- my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
- "$file | $CPAN::Config->{tar} xvf -";
- return system($system) == 0;
+ if ($^O =~ /win/i) { # irgggh
+ # people find the most curious tar binaries that cannot handle
+ # pipes
+ my $system = "$CPAN::Config->{'gzip'} --decompress $file";
+ if (system($system)==0) {
+ $CPAN::Frontend->myprint(qq{Uncompressed $file successfully\n});
+ } else {
+ $CPAN::Frontend->mydie(
+ qq{Couldn\'t uncompress $file\n}
+ );
+ }
+ $file =~ s/\.gz$//;
+ $system = "$CPAN::Config->{tar} xvf $file";
+ if (system($system)==0) {
+ $CPAN::Frontend->myprint(qq{Untarred $file successfully\n});
+ } else {
+ $CPAN::Frontend->mydie(qq{Couldn\'t untar $file\n});
+ }
+ return 1;
+ } else {
+ my $system = "$CPAN::Config->{'gzip'} --decompress --stdout " .
+ "< $file | $CPAN::Config->{tar} xvf -";
+ return system($system) == 0;
+ }
} elsif ($CPAN::META->has_inst("Archive::Tar")
&&
$CPAN::META->has_inst("Compress::Zlib") ) {
OpenGL-0.4/COPYRIGHT
[...]
-A C<clean> command results in a
+A C<clean> command results in a
make clean
=back
-=head2 Methods in the four
+=head2 Methods in the four Classes
=head2 Cache Manager
worth to give it a try and send me more specific output. You should
know that "o debug" has built-in completion support.
-=head2 Floppy, Zip, and all that Jazz
+=head2 Floppy, Zip, Offline Mode
CPAN.pm works nicely without network too. If you maintain machines
that are not networked at all, you should consider working with file:
make_install_arg same as make_arg for 'make install'
makepl_arg arguments passed to 'perl Makefile.PL'
pager location of external program more (or any pager)
+ scan_cache controls scanning of cache ('atstart' or 'never')
tar location of external program tar
unzip location of external program unzip
urllist arrayref to nearby CPAN sites (or equivalent locations)
wait_list arrayref to a wait server to try (See CPAN::WAIT)
+ ftp_proxy, } the three usual variables for configuring
+ http_proxy, } proxy requests. Both as CPAN::Config variables
+ no_proxy } and as environment variables configurable.
You can set and query each of these options interactively in the cpan
shell with the command set defined within the C<o conf> command:
for this is that the primary use is intended for the cpan shell or for
oneliners.
+=head1 POPULATE AN INSTALLATION WITH LOTS OF MODULES
+
+To populate a freshly installed perl with my favorite modules is pretty
+easiest by maintaining a private bundle definition file. To get a useful
+blueprint of a bundle definition file, the command autobundle can be used
+on the CPAN shell command line. This command writes a bundle definition
+file for all modules that re installed for the currently running perl
+interpreter. It's recommended to run this command only once and from then
+on maintain the file manually under a private name, say
+Bundle/my_bundle.pm. With a clever bundle file you can then simply say
+
+ cpan> install Bundle::my_bundle
+
+then answer a few questions and then go out.
+
+Maintaining a bundle definition file means to keep track of two things:
+dependencies and interactivity. CPAN.pm (currently) does not take into
+account dependencies between distributions, so a bundle definition file
+should specify distributions that depend on others B<after> the others.
+On the other hand, it's a bit annoying that many distributions need some
+interactive configuring. So what I try to accomplish in my private bundle
+file is to have the packages that need to be configured early in the file
+and the gentle ones later, so I can go out after a few minutes and leave
+CPAN.pm unattained.
+
+=head1 WORKING WITH CPAN.pm BEHIND FIREWALLS
+
+Thanks to Graham Barr for contributing the firewall following howto.
+
+Firewalls can be categorized into three basic types.
+
+=over
+
+=item http firewall
+
+This is where the firewall machine runs a web server and to access the
+outside world you must do it via the web server. If you set environment
+variables like http_proxy or ftp_proxy to a values beginning with http://
+or in your web browser you have to set proxy information then you know
+you are running a http firewall.
+
+To access servers outside these types of firewalls with perl (even for
+ftp) you will need to use LWP.
+
+=item ftp firewall
+
+This where the firewall machine runs a ftp server. This kind of firewall will
+only let you access ftp serves outside the firewall. This is usually done by
+connecting to the firewall with ftp, then entering a username like
+"user@outside.host.com"
+
+To access servers outside these type of firewalls with perl you
+will need to use Net::FTP.
+
+=item One way visibility
+
+I say one way visibility as these firewalls try to make themselves look
+invisible to the users inside the firewall. An FTP data connection is
+normally created by sending the remote server your IP address and then
+listening for the connection. But the remote server will not be able to
+connect to you because of the firewall. So for these types of firewall
+FTP connections need to be done in a passive mode.
+
+There are two that I can think off.
+
+=over
+
+=item SOCKS
+
+If you are using a SOCKS firewall you will need to compile perl and link
+it with the SOCKS library, this is what is normally called a ``socksified''
+perl. With this executable you will be able to connect to servers outside
+the firewall as if it is not there.
+
+=item IP Masquerade
+
+This is the firewall implemented in the Linux kernel, it allows you to
+hide a complete network behind one IP address. With this firewall no
+special compiling is need as you can access hosts directly.
+
+=back
+
+=back
+
=head1 BUGS
We should give coverage for _all_ of the CPAN and not just the PAUSE
use File::Basename ();
use File::Path ();
use vars qw($VERSION);
-$VERSION = substr q$Revision: 1.30 $, 10;
+$VERSION = substr q$Revision: 1.33 $, 10;
=head1 NAME
sub init {
my($configpm) = @_;
use Config;
- require CPAN::Nox;
+ unless ($CPAN::VERSION) {
+ require CPAN::Nox;
+ }
eval {require CPAN::Config;};
$CPAN::Config ||= {};
local($/) = "\n";
local($|) = 1;
my($ans,$default,$local,$cont,$url,$expected_size);
-
+
#
# Files, directories
#
}
}
$CPAN::Config->{cpan_home} = $ans;
-
+
print qq{
If you want, I can keep the source files after a build in the cpan
# XXX This the time when we refetch the index files (in days)
$CPAN::Config->{'index_expire'} = 1;
+ print qq{
+
+By default, each time the CPAN module is started, cache scanning
+is performed to keep the cache size in sync. To prevent from this,
+disable the cache scanning with 'never'.
+
+};
+
+ $default = $CPAN::Config->{scan_cache} || 'atstart';
+ do {
+ $ans = prompt("Perform cache scanning (atstart or never)?", $default);
+ } while ($ans ne 'atstart' && $ans ne 'never');
+ $CPAN::Config->{scan_cache} = $ans;
+
+ #
+ # prerequisites_policy
+ # Do we follow PREREQ_PM?
+ #
+ print qq{
+
+The CPAN module can detect when a module that which you are trying to
+build depends on prerequisites. If this happens, it can build the
+prerequisites for you automatically ('follow'), ask you for
+confirmation ('ask'), or just ignore them ('ignore'). Please set your
+policy to one of the three values.
+
+};
+
+ $default = $CPAN::Config->{prerequisites_policy} || 'follow';
+ do {
+ $ans = prompt("Perform cache scanning (follow, ask or ignore)?", $default);
+ } while ($ans ne 'follow' && $ans ne 'ask' && $ans ne 'ignore');
+ $CPAN::Config->{prerequisites_policy} = $ans;
+
#
# External programs
#
}
}
+sub picklist {
+ my($items,$prompt,$default,$require_nonempty,$empty_warning)=@_;
+ $default ||= '';
+
+ my ($item, $i);
+ for $item (@$items) {
+ printf "(%d) %s\n", ++$i, $item;
+ }
+
+ my @nums;
+ while (1) {
+ my $num = prompt($prompt,$default);
+ @nums = split (' ', $num);
+ (warn "invalid items entered, try again\n"), next
+ if grep (/\D/ || $_ < 1 || $_ > $i, @nums);
+ if ($require_nonempty) {
+ (warn "$empty_warning\n"), next
+ unless @nums;
+ }
+ last;
+ }
+ print "\n";
+ for (@nums) { $_-- }
+ @{$items}[@nums];
+}
+
sub read_mirrored_by {
my($local) = @_;
my(%all,$url,$expected_size,$default,$ans,$host,$dst,$country,$continent,@location);
/location\s+=\s+\"([^\"]+)/ and @location = (split /\s*,\s*/, $1) and
($continent, $country) = @location[-1,-2];
$continent =~ s/\s\(.*//;
+ $continent =~ s/\W+$//; # if Jarkko doesn't know latitude/longitude
/dst_dst\s+=\s+\"([^\"]+)/ and $dst = $1;
next unless $host && $dst && $continent && $country;
$all{$continent}{$country}{$dst} = CPAN::Mirrored::By->new($continent,$country,$dst);
}
$fh->close;
$CPAN::Config->{urllist} ||= [];
- if ($expected_size = @{$CPAN::Config->{urllist}}) {
- for $url (@{$CPAN::Config->{urllist}}) {
- # sanity check, scheme+colon, not "q" there:
- next unless $url =~ /^\w+:\/./;
- $all{"[From previous setup]"}{"found URL"}{$url}=CPAN::Mirrored::By->new('[From previous setup]','found URL',$url);
- }
+ my(@previous_urls);
+ if (@previous_urls = @{$CPAN::Config->{urllist}}) {
$CPAN::Config->{urllist} = [];
- } else {
- $expected_size = 6;
}
-
+
print qq{
-Now we need to know, where your favorite CPAN sites are located. Push
+Now we need to know where your favorite CPAN sites are located. Push
a few sites onto the array (just in case the first on the array won\'t
work). If you are mirroring CPAN to your local workstation, specify a
file: URL.
-You can enter the number in front of the URL on the next screen, a
-file:, ftp: or http: URL, or "q" to finish selecting.
+First, pick a nearby continent and country (you can pick several of
+each, separated by spaces, or none if you just want to keep your
+existing selections). Then, you will be presented with a list of URLs
+of CPAN mirrors in the countries you selected, along with previously
+selected URLs. Select some of those URLs, or just keep the old list.
+Finally, you will be prompted for any extra URLs -- file:, ftp:, or
+http: -- that host a CPAN mirror.
};
- $ans = prompt("Press RETURN to continue");
- my $other;
- $ans = $other = "";
- my(%seen);
-
- my $pipe = -t *STDIN ? "| $CPAN::Config->{'pager'}" : ">/dev/null";
- while () {
- my(@valid,$previous_best);
- my $fh = FileHandle->new;
- $fh->open($pipe);
- {
- my($cont,$country,$url,$item);
- my(@cont) = sort keys %all;
- for $cont (@cont) {
- $fh->print(" $cont\n");
- for $country (sort {lc $a cmp lc $b} keys %{$all{$cont}}) {
- for $url (sort {lc $a cmp lc $b} keys %{$all{$cont}{$country}}) {
- my $t = sprintf(
- " %-16s (%2d) %s\n",
- $country,
- ++$item,
- $url
- );
- if ($cont =~ /^\[/) {
- $previous_best ||= $item;
- }
- push @valid, $all{$cont}{$country}{$url};
- $fh->print($t);
- }
- }
- }
- }
- $fh->close;
- $previous_best ||= "";
- $default =
- @{$CPAN::Config->{urllist}} >=
- $expected_size ? "q" : $previous_best;
- $ans = prompt(
- "\nSelect an$other ftp or file URL or a number (q to finish)",
- $default
- );
- my $sel;
- if ($ans =~ /^\d/) {
- my $this = $valid[$ans-1];
- my($con,$cou,$url) = ($this->continent,$this->country,$this->url);
- push @{$CPAN::Config->{urllist}}, $url unless $seen{$url}++;
- delete $all{$con}{$cou}{$url};
- # print "Was a number [$ans] con[$con] cou[$cou] url[$url]\n";
- } elsif ($ans =~ /^q/i) {
- last;
- } else {
- $ans =~ s|/?$|/|; # has to end with one slash
- $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
- if ($ans =~ /^\w+:\/./) {
- push @{$CPAN::Config->{urllist}}, $ans unless $seen{$ans}++;
- } else {
- print qq{"$ans" doesn\'t look like an URL at first sight.
-I\'ll ignore it for now. You can add it to lib/CPAN/Config.pm
-later and report a bug in my Makefile.PL to me (andreas koenig).
-Thanks.\n};
- }
- }
- $other ||= "other";
+ my (@cont, $cont, %cont, @countries, @urls, %seen);
+ my $no_previous_warn =
+ "Sorry! since you don't have any existing picks, you must make a\n" .
+ "geographic selection.";
+ @cont = picklist([sort keys %all],
+ "Select your continent (or several nearby continents)",
+ '',
+ ! @previous_urls,
+ $no_previous_warn);
+
+
+ foreach $cont (@cont) {
+ my @c = sort keys %{$all{$cont}};
+ @cont{@c} = map ($cont, 0..$#c);
+ @c = map ("$_ ($cont)", @c) if @cont > 1;
+ push (@countries, @c);
}
+
+ if (@countries) {
+ @countries = picklist (\@countries,
+ "Select your country (or several nearby countries)",
+ '',
+ ! @previous_urls,
+ $no_previous_warn);
+ %seen = map (($_ => 1), @previous_urls);
+ # hmmm, should take list of defaults from CPAN::Config->{'urllist'}...
+ foreach $country (@countries) {
+ (my $bare_country = $country) =~ s/ \(.*\)//;
+ my @u = sort keys %{$all{$cont{$bare_country}}{$bare_country}};
+ @u = grep (! $seen{$_}, @u);
+ @u = map ("$_ ($bare_country)", @u)
+ if @countries > 1;
+ push (@urls, @u);
+ }
+ }
+ push (@urls, map ("$_ (previous pick)", @previous_urls));
+ my $prompt = "Select as many URLs as you like";
+ if (@previous_urls) {
+ $default = join (' ', ((scalar @urls) - (scalar @previous_urls) + 1) ..
+ (scalar @urls));
+ $prompt .= "\n(or just hit RETURN to keep your previous picks)";
+ }
+
+ @urls = picklist (\@urls, $prompt, $default);
+ foreach (@urls) { s/ \(.*\)//; }
+ %seen = map (($_ => 1), @urls);
+
+ do {
+ $ans = prompt ("Enter another URL or RETURN to quit:", "");
+
+ if ($ans) {
+ $ans =~ s|/?$|/|; # has to end with one slash
+ $ans = "file:$ans" unless $ans =~ /:/; # without a scheme is a file:
+ if ($ans =~ /^\w+:\/./) {
+ push @urls, $ans
+ unless $seen{$ans};
+ }
+ else {
+ print qq{"$ans" doesn\'t look like an URL at first sight.
+I\'ll ignore it for now. You can add it to $INC{'CPAN/MyConfig.pm'}
+later if you\'re sure it\'s right.\n};
+ }
+ }
+ } while $ans;
+
+ push @{$CPAN::Config->{urllist}}, @urls;
+ # xxx delete or comment these out when you're happy that it works
+ print "New set of picks:\n";
+ map { print " $_\n" } @{$CPAN::Config->{urllist}};
}
1;
detailed stack trace to be given. This can be very helpful when trying
to understand why, or from where, a warning or error is being generated.
-This feature is enabled by 'importing' the non-existant symbol
+This feature is enabled by 'importing' the non-existent symbol
'verbose'. You would typically enable it by saying
perl -MCarp=verbose script.pl
in Perl.
The abs_path() function takes a single argument and returns the
-absolute pathname for that argument. It uses the same algoritm as
+absolute pathname for that argument. It uses the same algorithm as
getcwd(). (actually getcwd() is abs_path("."))
The fastcwd() function looks the same as getcwd(), but runs faster.
where FOOBAR is the name of the current package when the C<__DATA__>
token is reached. This works just the same as C<__END__> does in
package 'main', but for other modules data after C<__END__> is not
-automatically retreivable , whereas data after C<__DATA__> is.
+automatically retrievable, whereas data after C<__DATA__> is.
The C<__DATA__> token is not recognized in versions of perl prior to
5.001m.
The B<SelfLoader> works similarly to the AutoLoader, but picks up the
subs from after the C<__DATA__> instead of in the 'lib/auto' directory.
-There is a maintainance gain in not needing to run AutoSplit on the module
+There is a maintenance gain in not needing to run AutoSplit on the module
at installation, and a runtime gain in not needing to keep opening and
closing files to load subs. There is a runtime loss in needing
to parse the code after the C<__DATA__>. Details of the B<AutoLoader> and
variable names (e.g. "myvar" -E<gt> "MyPackage::myvar"). If it is given a
second parameter, C<qualify> uses it as the default package;
otherwise, it uses the package of its caller. Regardless, global
-variable names (e.g. "STDOUT", "ENV", "SIG") are always qualfied with
+variable names (e.g. "STDOUT", "ENV", "SIG") are always qualified with
"main::".
Qualification applies only to symbol names (strings). References are
of hash refs that describe each test failure. Each hash will contain
at least the following fields: C<package>, C<repetition>, and
C<result>. (The file, line, and test number are not included because
-their correspondance to a particular test is tenuous.) If the test
+their correspondence to a particular test is tenuous.) If the test
had an expected value or a diagnostic string, these will also be
included.
diagnostics - Perl compiler pragma to force verbose warning diagnostics
-splain - standalone program to do the same thing
+splain - stand-alone program to do the same thing
=head1 SYNOPSIS
=head2 The C<diagnostics> Pragma
This module extends the terse diagnostics normally emitted by both the
-perl compiler and the perl interpeter, augmenting them with the more
+perl compiler and the perl interpreter, augmenting them with the more
explicative and endearing descriptions found in L<perldiag>. Like the
other pragmata, it affects the compilation phase of your program rather
than merely the execution phase.
compilation will then be subject(ed :-) to the enhanced diagnostics.
These still go out B<STDERR>.
-Due to the interaction between runtime and compiletime issues,
+Due to the interaction between runtime and compile time issues,
and because it's probably not a very good idea anyway,
-you may not use C<no diagnostics> to turn them off at compiletime.
+you may not use C<no diagnostics> to turn them off at compile time.
However, you may control there behaviour at runtime using the
disable() and enable() methods to turn them off and on respectively.
=head1 EXAMPLES
The following file is certain to trigger a few errors at both
-runtime and compiletime:
+runtime and compile time:
use diagnostics;
print NOWHERE "nothing\n";
to be assigned to the value in the left-hand-side if different from
this value.
-This allows for the same method to be used as averloaded C<+=> and
+This allows for the same method to be used as overloaded C<+=> and
C<+>. Note that this is I<allowed>, but not recommended, since by the
semantic of L<"Fallback"> Perl will call the method for C<+> anyway,
if C<+=> is not overloaded.
B<Warning.> Due to the presense of assignment versions of operations,
routines which may be called in assignment context may create
-self-referencial structures. Currently Perl will not free self-referential
+self-referential structures. Currently Perl will not free self-referential
structures until cycles are C<explicitly> broken. You may get problems
when traversing your structures too.
=back
-Same behaviour is triggered by C<$b = $a++>, which is consider a synonim for
+Same behaviour is triggered by C<$b = $a++>, which is consider a synonym for
C<$b = $a; ++$a>.
=head1 MAGIC AUTOGENERATION
size penalty if overload is used in some package is that I<all> the
packages acquire a magic during the next C<bless>ing into the
package. This magic is three-words-long for packages without
-overloading, and carries the cache tabel if the package is overloaded.
+overloading, and carries the cache table if the package is overloaded.
Copying (C<$a=$b>) is shallow; however, a one-level-deep copying is
carried out before any operation that can imply an assignment to the
=head1 Metaphor clash
-One may wonder why the semantic of overloaded C<=> is so counterintuive.
-If it I<looks> counterintuive to you, you are subject to a metaphor
+One may wonder why the semantic of overloaded C<=> is so counter intuitive.
+If it I<looks> counter intuitive to you, you are subject to a metaphor
clash.
Here is a Perl object metaphor:
This module is very unusual as overloaded modules go: it does not
provide any usual overloaded operators, instead it provides the L<Last
Resort> operator C<nomethod>. In this example the corresponding
-subroutine returns an object which encupsulates operations done over
+subroutine returns an object which encapsulates operations done over
the objects: C<new symbolic 3> contains C<['n', 3]>, C<2 + new
symbolic 3> contains C<['+', 2, ['n', 3]]>.
conversion routine.
Here is the text of F<symbolic.pm> with such a routine added (and
-slightly modifed str()):
+slightly modified str()):
package symbolic; # Primitive symbolic calculator
use overload
}
All the work of numeric conversion is done in %subr and num(). Of
-course, %subr is not complete, it contains only operators used in teh
+course, %subr is not complete, it contains only operators used in the
example below. Here is the extra-credit question: why do we need an
explicit recursion in num()? (Answer is at the end of this section.)
(not required without mutators!), and implements only those arithmetic
operations which are used in the example.
-To implement most arithmetic operattions is easy, one should just use
+To implement most arithmetic operations is easy, one should just use
the tables of operations, and change the code which fills %subr to
my %subr = ( 'n' => sub {$_[0]} );
If you wonder why defaults for conversion are different for str() and
num(), note how easy it was to write the symbolic calculator. This
simplicity is due to an appropriate choice of defaults. One extra
-note: due to teh explicit recursion num() is more fragile than sym():
-we need to explicitly check for the type of $a and $b. If componets
+note: due to the explicit recursion num() is more fragile than sym():
+we need to explicitly check for the type of $a and $b. If components
$a and $b happen to be of some related type, this may lead to problems.
=head2 I<Really> symbolic calculator
projects / p5sagit/p5-mst-13.2.git / commitdiff