diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/AutoLoader.pm | 4 | ||||
-rw-r--r-- | lib/CGI.pm | 38 | ||||
-rw-r--r-- | lib/CPAN.pm | 456 | ||||
-rw-r--r-- | lib/CPAN/FirstTime.pm | 225 | ||||
-rw-r--r-- | lib/Carp.pm | 2 | ||||
-rw-r--r-- | lib/Cwd.pm | 2 | ||||
-rw-r--r-- | lib/SelfLoader.pm | 4 | ||||
-rw-r--r-- | lib/Symbol.pm | 2 | ||||
-rw-r--r-- | lib/Test.pm | 2 | ||||
-rwxr-xr-x | lib/diagnostics.pm | 10 | ||||
-rw-r--r-- | lib/overload.pm | 24 |
11 files changed, 570 insertions, 199 deletions
diff --git a/lib/AutoLoader.pm b/lib/AutoLoader.pm index 666c6cacf9..5b083a7894 100644 --- a/lib/AutoLoader.pm +++ b/lib/AutoLoader.pm @@ -178,7 +178,7 @@ such a file exists, AUTOLOAD will read and evaluate it, 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 @@ -266,7 +266,7 @@ C<__DATA__>, after which routines are cached. B<SelfLoader> can also 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. diff --git a/lib/CGI.pm b/lib/CGI.pm index 22d91a46c7..9fe8f40d6b 100644 --- a/lib/CGI.pm +++ b/lib/CGI.pm @@ -3273,10 +3273,10 @@ the CGI script, and because each object's parameter list is 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 @@ -3319,7 +3319,7 @@ acceptable. In fact, only the first argument needs to begin with a 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: @@ -3667,7 +3667,7 @@ methods, and then use them directly: $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: @@ -3719,7 +3719,7 @@ provide for the rapidly-evolving HTML "standard." For example, say 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'}); @@ -3799,7 +3799,7 @@ This causes the indicated autoloaded methods to be compiled up front, 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); @@ -4114,19 +4114,19 @@ header. Just pass the list of script sections as an array reference. 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' } ] ); @@ -4262,7 +4262,7 @@ This example shows how to use the HTML methods: 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; @@ -4325,7 +4325,7 @@ that points to an undef string: 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 @@ -5093,7 +5093,7 @@ To include row and column headings in the returned table, you 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 diff --git a/lib/CPAN.pm b/lib/CPAN.pm index 3c94cd9f0d..f12d41c0e6 100644 --- a/lib/CPAN.pm +++ b/lib/CPAN.pm @@ -5,13 +5,13 @@ use vars qw{$Try_autoload $Revision $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 (); @@ -224,7 +224,7 @@ sub AUTOLOAD { $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 }); } @@ -254,7 +254,7 @@ sub try_dot_al { 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) { @@ -269,7 +269,7 @@ sub try_dot_al { *$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 ($@){ @@ -316,10 +316,80 @@ use vars qw($AUTOLOAD @ISA); 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; @@ -632,7 +702,7 @@ sub disk_usage { sub { $File::Find::prune++ if $CPAN::Signal; return if -l $_; - $Du += -s _; + $Du += (-s _); # parens to help cperl-mode }, $dir ); @@ -664,26 +734,36 @@ sub new { 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; @@ -788,6 +868,7 @@ Please specify a filename where to save the configuration or try 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) { @@ -832,6 +913,7 @@ sub init { sub load { my($self) = shift; my(@miss); + use Carp; eval {require CPAN::Config;}; # We eval because of some # MakeMaker problems unless ($dot_cpan++){ @@ -896,11 +978,11 @@ sub load { } } 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. }); @@ -912,9 +994,10 @@ $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->{$_}; } @@ -1032,7 +1115,9 @@ sub b { #-> 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 { @@ -1509,22 +1594,23 @@ sub rematein { 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; @@ -1539,7 +1625,9 @@ sub rematein { 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( @@ -1549,7 +1637,9 @@ sub rematein { " ;-)\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/ @@ -1557,6 +1647,7 @@ Try the command to find objects with similar identifiers. }); } + CPAN::Queue->delete_first($s); } } @@ -1609,7 +1700,7 @@ sub ftp_get { } # 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,> *************** @@ -1713,7 +1804,7 @@ sub localize { @reordered = sort { (substr($CPAN::Config->{urllist}[$b],0,4) eq "file") - <=> + <=> (substr($CPAN::Config->{urllist}[$a],0,4) eq "file") or defined($Thesite) @@ -1807,6 +1898,10 @@ sub hosteasy { $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; @@ -1877,7 +1972,7 @@ sub hosthard { # 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); @@ -1937,9 +2032,9 @@ Trying with "$funkyftp$source_switch" to get 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; @@ -2097,7 +2192,6 @@ sub talk_ftp { Subprocess "|$command" returned status $estatus (wstat $wstatus) }) if $wstatus; - } # find2perl needs modularization, too, all the following is stolen @@ -2403,7 +2497,7 @@ sub rd_authindex { 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 @@ -2437,11 +2531,11 @@ sub rd_modpacks { # 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; @@ -2992,16 +3086,14 @@ sub eq_MD5 { #-> 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 { @@ -3145,6 +3237,30 @@ or $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"); @@ -3156,6 +3272,57 @@ or } } +#-> 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) = @_; @@ -3244,7 +3411,8 @@ sub install { 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($_); @@ -3253,7 +3421,7 @@ sub install { $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"); @@ -3342,7 +3510,6 @@ sub find_bundle_file { ### 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; @@ -3355,20 +3522,22 @@ sub find_bundle_file { 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"); } @@ -3397,7 +3566,7 @@ sub rematein { 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'; @@ -3408,7 +3577,26 @@ explicitly a file $s. }); 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'; + } } } @@ -3431,7 +3619,6 @@ sub test { shift->rematein('test',@_); } sub install { my $self = shift; $self->rematein('install',@_); - $CPAN::META->delete('CPAN::Queue',$self->id); } #-> sub CPAN::Bundle::clean ; sub clean { shift->rematein('clean',@_); } @@ -3588,7 +3775,7 @@ sub cpan_file { #-> 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 @@ -3642,10 +3829,9 @@ sub get { shift->rematein('get',@_); } 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; @@ -3659,16 +3845,25 @@ sub install { 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') } @@ -3731,7 +3926,7 @@ sub gzip { $fhw->close; return 1; } else { - system("$CPAN::Config->{'gzip'} -c $read > $write")==0; + system("$CPAN::Config->{'gzip'} -c $read > $write")==0; } } @@ -3833,9 +4028,30 @@ sub untar { 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") ) { @@ -3994,7 +4210,7 @@ Example: OpenGL-0.4/COPYRIGHT [...] -A C<clean> command results in a +A C<clean> command results in a make clean @@ -4144,7 +4360,7 @@ functionalities that are available in the shell. =back -=head2 Methods in the four +=head2 Methods in the four Classes =head2 Cache Manager @@ -4250,7 +4466,7 @@ have an idea which part of the package may have a bug, it's sometimes 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: @@ -4289,10 +4505,14 @@ defined: 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: @@ -4360,6 +4580,90 @@ Most functions in package CPAN are exported per default. The reason 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 diff --git a/lib/CPAN/FirstTime.pm b/lib/CPAN/FirstTime.pm index ff1f723d5e..14ef54169b 100644 --- a/lib/CPAN/FirstTime.pm +++ b/lib/CPAN/FirstTime.pm @@ -16,7 +16,7 @@ use FileHandle (); 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 @@ -37,7 +37,9 @@ file. Nothing special. sub init { my($configpm) = @_; use Config; - require CPAN::Nox; + unless ($CPAN::VERSION) { + require CPAN::Nox; + } eval {require CPAN::Config;}; $CPAN::Config ||= {}; local($/) = "\n"; @@ -45,7 +47,7 @@ sub init { local($|) = 1; my($ans,$default,$local,$cont,$url,$expected_size); - + # # Files, directories # @@ -120,7 +122,7 @@ First of all, I\'d like to create this directory. Where? } } $CPAN::Config->{cpan_home} = $ans; - + print qq{ If you want, I can keep the source files after a build in the cpan @@ -151,6 +153,40 @@ with all the intermediate files? # 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 # @@ -329,6 +365,32 @@ sub find_exe { } } +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); @@ -341,6 +403,7 @@ sub read_mirrored_by { /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); @@ -349,93 +412,97 @@ sub read_mirrored_by { } $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; diff --git a/lib/Carp.pm b/lib/Carp.pm index 6bac36446a..c6545650ef 100644 --- a/lib/Carp.pm +++ b/lib/Carp.pm @@ -35,7 +35,7 @@ and a carp as a cluck across I<all> modules. In other words, force a 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 diff --git a/lib/Cwd.pm b/lib/Cwd.pm index 72937e25d8..5c10e8e168 100644 --- a/lib/Cwd.pm +++ b/lib/Cwd.pm @@ -32,7 +32,7 @@ The getcwd() function re-implements the getcwd(3) (or getwd(3)) functions 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. diff --git a/lib/SelfLoader.pm b/lib/SelfLoader.pm index a73f68a8c4..311d953721 100644 --- a/lib/SelfLoader.pm +++ b/lib/SelfLoader.pm @@ -133,7 +133,7 @@ is available for reading via the filehandle FOOBAR::DATA, 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. @@ -203,7 +203,7 @@ There is no need to inherit from the B<SelfLoader>. 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 diff --git a/lib/Symbol.pm b/lib/Symbol.pm index 5ed6b2667b..a842c1cd7b 100644 --- a/lib/Symbol.pm +++ b/lib/Symbol.pm @@ -46,7 +46,7 @@ C<Symbol::qualify> turns unqualified symbol names into qualified 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 diff --git a/lib/Test.pm b/lib/Test.pm index daf6e4e127..00b32368d8 100644 --- a/lib/Test.pm +++ b/lib/Test.pm @@ -220,7 +220,7 @@ triggered at the end of a test run. C<onfail> is passed an array ref 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. diff --git a/lib/diagnostics.pm b/lib/diagnostics.pm index f74e7352e4..648ea1281b 100755 --- a/lib/diagnostics.pm +++ b/lib/diagnostics.pm @@ -4,7 +4,7 @@ package diagnostics; 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 @@ -27,7 +27,7 @@ Aa a program: =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. @@ -41,9 +41,9 @@ that this I<does> enable perl's B<-w> flag.) Your whole 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. @@ -66,7 +66,7 @@ Output from I<splain> is directed to B<STDOUT>, unlike the pragma. =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"; diff --git a/lib/overload.pm b/lib/overload.pm index 81d9a120ba..6508ad1cf4 100644 --- a/lib/overload.pm +++ b/lib/overload.pm @@ -276,7 +276,7 @@ value of their arguments, and may leave it as is. The result is going 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. @@ -285,7 +285,7 @@ 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. @@ -558,7 +558,7 @@ C<'='> was overloaded with C<\&clone>. =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 @@ -777,7 +777,7 @@ There is no size penalty for data if overload is not used. The only 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 @@ -789,8 +789,8 @@ to be changed are constant (but this is not enforced). =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: @@ -1025,7 +1025,7 @@ Put this in F<symbolic.pm> in your Perl library directory: 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]]>. @@ -1112,7 +1112,7 @@ compare an object to 0. In fact, it is easier to write a numeric 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 @@ -1151,7 +1151,7 @@ slightly modifed str()): } 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.) @@ -1181,7 +1181,7 @@ mutator methods (C<++>, C<-=> and so on), does not do deep copying (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]} ); @@ -1259,8 +1259,8 @@ the argument of num(). 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 |