This is an automated email from the git hooks/post-receive script. dom pushed a commit to branch master in repository libclass-errorhandler-perl.
commit fcb9bb13e5f7628200ad32701685dc63e8c079c7 Author: Dominic Hargreaves <d...@earth.li> Date: Tue Oct 23 22:20:37 2007 +0000 [svn-inject] Installing original source of libclass-errorhandler-perl --- Build.PL | 3 + Changes | 6 + MANIFEST | 21 ++ META.yml | 11 + Makefile.PL | 18 ++ README | 26 ++ inc/ExtUtils/AutoInstall.pm | 631 ++++++++++++++++++++++++++++++++++++++ inc/Module/Install.pm | 171 +++++++++++ inc/Module/Install/AutoInstall.pm | 65 ++++ inc/Module/Install/Base.pm | 57 ++++ inc/Module/Install/Build.pm | 66 ++++ inc/Module/Install/Can.pm | 41 +++ inc/Module/Install/Fetch.pm | 89 ++++++ inc/Module/Install/Include.pm | 12 + inc/Module/Install/Makefile.pm | 146 +++++++++ inc/Module/Install/Metadata.pm | 190 ++++++++++++ inc/Module/Install/Win32.pm | 66 ++++ inc/Module/Install/WriteAll.pm | 39 +++ lib/Class/ErrorHandler.pm | 100 ++++++ t/00-compile.t | 8 + t/01-errors.t | 26 ++ 21 files changed, 1792 insertions(+) diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..03fd8de --- /dev/null +++ b/Build.PL @@ -0,0 +1,3 @@ +# $Id: Build.PL,v 1.1.1.1 2004/08/15 14:55:43 btrott Exp $ + +require 'Makefile.PL'; diff --git a/Changes b/Changes new file mode 100644 index 0000000..ed42184 --- /dev/null +++ b/Changes @@ -0,0 +1,6 @@ +# $Id: Changes,v 1.1.1.1 2004/08/15 14:55:43 btrott Exp $ + +Revision history for Class::ErrorHandler + +0.01 2004.08.15 + - Initial distribution. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..ee0faf1 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,21 @@ +Build.PL +Changes +inc/ExtUtils/AutoInstall.pm +inc/Module/Install.pm +inc/Module/Install/AutoInstall.pm +inc/Module/Install/Base.pm +inc/Module/Install/Build.pm +inc/Module/Install/Can.pm +inc/Module/Install/Fetch.pm +inc/Module/Install/Include.pm +inc/Module/Install/Makefile.pm +inc/Module/Install/Metadata.pm +inc/Module/Install/Win32.pm +inc/Module/Install/WriteAll.pm +lib/Class/ErrorHandler.pm +Makefile.PL +MANIFEST This list of files +META.yml +README +t/00-compile.t +t/01-errors.t diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..729efa0 --- /dev/null +++ b/META.yml @@ -0,0 +1,11 @@ +name: Class-ErrorHandler +version: 0.01 +abstract: Base class for error handling +author: Benjamin Trott <c...@stupidfool.org> +license: perl +distribution_type: module +no_index: + directory: + - t + - inc +generated_by: Module::Install version 0.33 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..21d6398 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +# $Id: Makefile.PL,v 1.1.1.1 2004/08/15 14:55:43 btrott Exp $ + +use inc::Module::Install; + +name('Class-ErrorHandler'); +abstract('Base class for error handling'); +author('Benjamin Trott <c...@stupidfool.org>'); +version_from('lib/Class/ErrorHandler.pm'); +license('perl'); +no_index(directory => 't'); +sign(1); + +include('ExtUtils::AutoInstall'); + +auto_include(); +auto_install(); + +&WriteAll; diff --git a/README b/README new file mode 100644 index 0000000..21bd89a --- /dev/null +++ b/README @@ -0,0 +1,26 @@ +$Id: README,v 1.1.1.1 2004/08/15 14:55:43 btrott Exp $ + +This is Class::ErrorHandler, a base class for classes that need to do +error handling (which is, probably, most of them). + +PREREQUISITES + +None. + +INSTALLATION + +Class::ErrorHandler installation is straightforward. If your CPAN shell +is set up, you should just be able to do + + % perl -MCPAN -e 'install Class::ErrorHandler' + +Download it, unpack it, then build it as per the usual: + + % perl Makefile.PL + % make && make test + +Then install it: + + % make install + +Benjamin Trott / c...@stupidfool.org diff --git a/inc/ExtUtils/AutoInstall.pm b/inc/ExtUtils/AutoInstall.pm new file mode 100644 index 0000000..5e43c13 --- /dev/null +++ b/inc/ExtUtils/AutoInstall.pm @@ -0,0 +1,631 @@ +#line 1 "inc/ExtUtils/AutoInstall.pm - /Library/Perl/5.8.1/ExtUtils/AutoInstall.pm" +# $File: //member/autrijus/ExtUtils-AutoInstall/lib/ExtUtils/AutoInstall.pm $ +# $Revision: #9 $ $Change: 9532 $ $DateTime: 2004/01/01 06:47:30 $ vim: expandtab shiftwidth=4 + +package ExtUtils::AutoInstall; +$ExtUtils::AutoInstall::VERSION = '0.56'; + +use strict; +use Cwd (); +use ExtUtils::MakeMaker (); + +#line 282 + +# special map on pre-defined feature sets +my %FeatureMap = ( + '' => 'Core Features', # XXX: deprecated + '-core' => 'Core Features', +); + +# various lexical flags +my (@Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS); +my ($Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly); +my ($PostambleActions, $PostambleUsed); + +$AcceptDefault = 1 unless -t STDIN; # non-interactive session +_init(); + +sub missing_modules { + return @Missing; +} + +sub do_install { + __PACKAGE__->install( + [ UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config}], + @Missing, + ); +} + +# initialize various flags, and/or perform install +sub _init { + foreach my $arg (@ARGV, split(/[\s\t]+/, $ENV{PERL_EXTUTILS_AUTOINSTALL} || '')) { + if ($arg =~ /^--config=(.*)$/) { + $Config = [ split(',', $1) ]; + } + elsif ($arg =~ /^--installdeps=(.*)$/) { + __PACKAGE__->install($Config, @Missing = split(/,/, $1)); + exit 0; + } + elsif ($arg =~ /^--default(?:deps)?$/) { + $AcceptDefault = 1; + } + elsif ($arg =~ /^--check(?:deps)?$/) { + $CheckOnly = 1; + } + elsif ($arg =~ /^--skip(?:deps)?$/) { + $SkipInstall = 1; + } + elsif ($arg =~ /^--test(?:only)?$/) { + $TestOnly = 1; + } + } +} + +# overrides MakeMaker's prompt() to automatically accept the default choice +sub _prompt { + goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; + + my ($prompt, $default) = @_; + my $y = ($default =~ /^[Yy]/); + + print $prompt, ' [', ($y ? 'Y' : 'y'), '/', ($y ? 'n' : 'N'), '] '; + print "$default\n"; + return $default; +} + +# the workhorse +sub import { + my $class = shift; + my @args = @_ or return; + my $core_all; + + print "*** $class version ".$class->VERSION."\n"; + print "*** Checking for dependencies...\n"; + + my $cwd = Cwd::cwd(); + + $Config = []; + + my $maxlen = length((sort { length($b) <=> length($a) } + grep { /^[^\-]/ } + map { ref($_) ? keys %{ref($_) eq 'HASH' ? $_ : +{@{$_}}} : '' } + map { +{@args}->{$_} } + grep { /^[^\-]/ or /^-core$/i } keys %{+{@args}})[0]); + + while (my ($feature, $modules) = splice(@args, 0, 2)) { + my (@required, @tests, @skiptests); + my $default = 1; + my $conflict = 0; + + if ($feature =~ m/^-(\w+)$/) { + my $option = lc($1); + + # check for a newer version of myself + _update_to($modules, @_) and return if $option eq 'version'; + + # sets CPAN configuration options + $Config = $modules if $option eq 'config'; + + # promote every features to core status + $core_all = ($modules =~ /^all$/i) and next + if $option eq 'core'; + + next unless $option eq 'core'; + } + + print "[".($FeatureMap{lc($feature)} || $feature)."]\n"; + + $modules = [ %{$modules} ] if UNIVERSAL::isa($modules, 'HASH'); + + unshift @$modules, -default => &{shift(@$modules)} + if (ref($modules->[0]) eq 'CODE'); # XXX: bugward combatability + + while (my ($mod, $arg) = splice(@$modules, 0, 2)) { + if ($mod =~ m/^-(\w+)$/) { + my $option = lc($1); + + $default = $arg if ($option eq 'default'); + $conflict = $arg if ($option eq 'conflict'); + @tests = @{$arg} if ($option eq 'tests'); + @skiptests = @{$arg} if ($option eq 'skiptests'); + + next; + } + + printf("- %-${maxlen}s ...", $mod); + + # XXX: check for conflicts and uninstalls(!) them. + if (defined(my $cur = _version_check(_load($mod), $arg ||= 0))) { + print "loaded. ($cur".($arg ? " >= $arg" : '').")\n"; + push @Existing, $mod => $arg; + $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; + } + else { + print "missing." . ($arg ? " (would need $arg)" : '') . "\n"; + push @required, $mod => $arg; + } + } + + next unless @required; + + my $mandatory = ($feature eq '-core' or $core_all); + + if (!$SkipInstall and ($CheckOnly or _prompt( + qq{==> Auto-install the }. (@required / 2). + ($mandatory ? ' mandatory' : ' optional'). + qq{ module(s) from CPAN?}, $default ? 'y' : 'n', + ) =~ /^[Yy]/)) { + push (@Missing, @required); + $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; + } + + elsif (!$SkipInstall and $default and $mandatory and _prompt( + qq{==> The module(s) are mandatory! Really skip?}, 'n', + ) =~ /^[Nn]/) { + push (@Missing, @required); + $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; + } + + else { + $DisabledTests{$_} = 1 for map { glob($_) } @tests; + } + } + + _check_lock(); # check for $UnderCPAN + + if (@Missing and not ($CheckOnly or $UnderCPAN)) { + require Config; + print "*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n"; + # make an educated guess of whether we'll need root permission. + print " (You may need to do that as the 'root' user.)\n" if eval '$>'; + } + print "*** $class configuration finished.\n"; + + chdir $cwd; + + # import to main:: + no strict 'refs'; + *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; +} + +# CPAN.pm is non-reentrant, so check if we're under it and have no CPANPLUS +sub _check_lock { + return unless @Missing; + return if _has_cpanplus(); + + require CPAN; CPAN::Config->load; + my $lock = MM->catfile($CPAN::Config->{cpan_home}, ".lock"); + + if (-f $lock and open(LOCK, $lock) + and ($^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid()) + and ($CPAN::Config->{prerequisites_policy} || '') ne 'ignore' + ) { + print << '.'; + +*** Since we're running under CPAN, I'll just let it take care + of the dependency's installation later. +. + $UnderCPAN = 1; + } + + close LOCK; +} + +sub install { + my $class = shift; + + my $i; # used below to strip leading '-' from config keys + my @config = (map { s/^-// if ++$i; $_ } @{+shift}); + + my (@modules, @installed); + while (my ($pkg, $ver) = splice(@_, 0, 2)) { + # grep out those already installed + if (defined(_version_check(_load($pkg), $ver))) { + push @installed, $pkg; + } + else { + push @modules, $pkg, $ver; + } + } + + return @installed unless @modules; # nothing to do + + print "*** Installing dependencies...\n"; + + return unless _connected_to('cpan.org'); + + my %args = @config; + my %failed; + local *FAILED; + if ($args{do_once} and open(FAILED, '.#autoinstall.failed')) { + while (<FAILED>) { chomp; $failed{$_}++ } + close FAILED; + + my @newmod; + while (my ($k, $v) = splice(@modules, 0, 2)) { + push @newmod, ($k => $v) unless $failed{$k}; + } + @modules = @newmod; + } + + if (_has_cpanplus()) { + _install_cpanplus(\@modules, \@config); + } + else { + _install_cpan(\@modules, \@config); + } + + print "*** $class installation finished.\n"; + + # see if we have successfully installed them + while (my ($pkg, $ver) = splice(@modules, 0, 2)) { + if (defined(_version_check(_load($pkg), $ver))) { + push @installed, $pkg; + } + elsif ($args{do_once} and open(FAILED, '>> .#autoinstall.failed')) { + print FAILED "$pkg\n"; + } + } + + close FAILED if $args{do_once}; + + return @installed; +} + +sub _install_cpanplus { + my @modules = @{+shift}; + my @config = @{+shift}; + my $installed = 0; + + require CPANPLUS::Backend; + my $cp = CPANPLUS::Backend->new; + my $conf = $cp->configure_object; + + return unless _can_write($conf->_get_build('base')); + + # if we're root, set UNINST=1 to avoid trouble unless user asked for it. + my $makeflags = $conf->get_conf('makeflags') || ''; + if (UNIVERSAL::isa($makeflags, 'HASH')) { + # 0.03+ uses a hashref here + $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; + } + else { + # 0.02 and below uses a scalar + $makeflags = join(' ', split(' ', $makeflags), 'UNINST=1') + if ($makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' }); + } + $conf->set_conf(makeflags => $makeflags); + + while (my ($key, $val) = splice(@config, 0, 2)) { + eval { $conf->set_conf($key, $val) }; + } + + my $modtree = $cp->module_tree; + while (my ($pkg, $ver) = splice(@modules, 0, 2)) { + print "*** Installing $pkg...\n"; + + MY::preinstall($pkg, $ver) or next if defined &MY::preinstall; + + my $success; + my $obj = $modtree->{$pkg}; + + if ($obj and defined(_version_check($obj->{version}, $ver))) { + my $pathname = $pkg; $pathname =~ s/::/\\W/; + + foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) { + delete $INC{$inc}; + } + + my $rv = $cp->install( modules => [ $obj->{module} ]); + + if ($rv and ($rv->{$obj->{module}} or $rv->{ok})) { + print "*** $pkg successfully installed.\n"; + $success = 1; + } + else { + print "*** $pkg installation cancelled.\n"; + $success = 0; + } + + $installed += $success; + } + else { + print << "."; +*** Could not find a version $ver or above for $pkg; skipping. +. + } + + MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall; + } + + return $installed; +} + +sub _install_cpan { + my @modules = @{+shift}; + my @config = @{+shift}; + my $installed = 0; + my %args; + + require CPAN; CPAN::Config->load; + + return unless _can_write(MM->catfile($CPAN::Config->{cpan_home}, 'sources')); + + # if we're root, set UNINST=1 to avoid trouble unless user asked for it. + my $makeflags = $CPAN::Config->{make_install_arg} || ''; + $CPAN::Config->{make_install_arg} = join(' ', split(' ', $makeflags), 'UNINST=1') + if ($makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' }); + + # don't show start-up info + $CPAN::Config->{inhibit_startup_message} = 1; + + # set additional options + while (my ($opt, $arg) = splice(@config, 0, 2)) { + ($args{$opt} = $arg, next) + if $opt =~ /^force$/; # pseudo-option + $CPAN::Config->{$opt} = $arg; + } + + while (my ($pkg, $ver) = splice(@modules, 0, 2)) { + MY::preinstall($pkg, $ver) or next if defined &MY::preinstall; + + print "*** Installing $pkg...\n"; + + my $obj = CPAN::Shell->expand(Module => $pkg); + my $success = 0; + + if ($obj and defined(_version_check($obj->cpan_version, $ver))) { + my $pathname = $pkg; $pathname =~ s/::/\\W/; + + foreach my $inc (grep { m/$pathname.pm/i } keys(%INC)) { + delete $INC{$inc}; + } + + $obj->force('install') if $args{force}; + + if ($obj->install eq 'YES') { + print "*** $pkg successfully installed.\n"; + $success = 1; + } + else { + print "*** $pkg installation failed.\n"; + $success = 0; + } + + $installed += $success; + } + else { + print << "."; +*** Could not find a version $ver or above for $pkg; skipping. +. + } + + MY::postinstall($pkg, $ver, $success) if defined &MY::postinstall; + } + + return $installed; +} + +sub _has_cpanplus { + return ( + $HasCPANPLUS = ( + $INC{'CPANPLUS/Config.pm'} or + _load('CPANPLUS::Shell::Default') + ) + ); +} + +# make guesses on whether we're under the CPAN installation directory +sub _under_cpan { + require Cwd; + require File::Spec; + + my $cwd = File::Spec->canonpath(Cwd::cwd()); + my $cpan = File::Spec->canonpath($CPAN::Config->{cpan_home}); + + return (index($cwd, $cpan) > -1); +} + +sub _update_to { + my $class = __PACKAGE__; + my $ver = shift; + + return if defined(_version_check(_load($class), $ver)); # no need to upgrade + + if (_prompt( + "==> A newer version of $class ($ver) is required. Install?", 'y' + ) =~ /^[Nn]/) { + die "*** Please install $class $ver manually.\n"; + } + + print << "."; +*** Trying to fetch it from CPAN... +. + + # install ourselves + _load($class) and return $class->import(@_) + if $class->install([], $class, $ver); + + print << '.'; exit 1; + +*** Cannot bootstrap myself. :-( Installation terminated. +. +} + +# check if we're connected to some host, using inet_aton +sub _connected_to { + my $site = shift; + + return ( + ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(qq( +*** Your host cannot resolve the domain name '$site', which + probably means the Internet connections are unavailable. +==> Should we try to install the required module(s) anyway?), 'n' + ) =~ /^[Yy]/ + ); +} + +# check if a directory is writable; may create it on demand +sub _can_write { + my $path = shift; + mkdir ($path, 0755) unless -e $path; + + require Config; + return 1 if -w $path and -w $Config::Config{sitelib}; + + print << "."; +*** You are not allowed to write to the directory '$path'; + the installation may fail due to insufficient permissions. +. + + if (eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(qq( +==> Should we try to re-execute the autoinstall process with 'sudo'?), 'y' + ) =~ /^[Yy]/) { + # try to bootstrap ourselves from sudo + print << "."; +*** Trying to re-execute the autoinstall process with 'sudo'... +. + my $missing = join(',', @Missing); + my $config = join(',', + UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config} + ) if $Config; + + return unless system('sudo', $^X, $0, "--config=$config", "--installdeps=$missing"); + + print << "."; +*** The 'sudo' command exited with error! Resuming... +. + } + + return _prompt(qq( +==> Should we try to install the required module(s) anyway?), 'n' + ) =~ /^[Yy]/ +} + +# load a module and return the version it reports +sub _load { + my $mod = pop; # class/instance doesn't matter + my $file = $mod; + + $file =~ s|::|/|g; + $file .= '.pm'; + + local $@; + return eval { require $file; $mod->VERSION } || ($@ ? undef : 0); +} + +# compare two versions, either use Sort::Versions or plain comparison +sub _version_check { + my ($cur, $min) = @_; + return unless defined $cur; + + $cur =~ s/\s+$//; + + # check for version numbers that are not in decimal format + if (ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./) { + if ($version::VERSION or defined(_load('version'))) { + # use version.pm if it is installed. + return ((version->new($cur) >= version->new($min)) ? $cur : undef); + } + elsif ($Sort::Versions::VERSION or defined(_load('Sort::Versions'))) { + # use Sort::Versions as the sorting algorithm for a.b.c versions + return ((Sort::Versions::versioncmp($cur, $min) != -1) ? $cur : undef); + } + + warn "Cannot reliably compare non-decimal formatted versions.\n". + "Please install version.pm or Sort::Versions.\n"; + } + + # plain comparison + local $^W = 0; # shuts off 'not numeric' bugs + return ($cur >= $min ? $cur : undef); +} + +# nothing; this usage is deprecated. +sub main::PREREQ_PM { return {}; } + +sub _make_args { + my %args = @_; + + $args{PREREQ_PM} = { %{$args{PREREQ_PM} || {} }, @Existing, @Missing } + if $UnderCPAN or $TestOnly; + + if ($args{EXE_FILES}) { + require ExtUtils::Manifest; + my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); + + $args{EXE_FILES} = [ + grep { exists $manifest->{$_} } @{$args{EXE_FILES}} + ]; + } + + $args{test}{TESTS} ||= 't/*.t'; + $args{test}{TESTS} = join(' ', grep { + !exists($DisabledTests{$_}) + } map { glob($_) } split(/\s+/, $args{test}{TESTS})); + + my $missing = join(',', @Missing); + my $config = join(',', + UNIVERSAL::isa($Config, 'HASH') ? %{$Config} : @{$Config} + ) if $Config; + + $PostambleActions = ( + $missing ? "\$(PERL) $0 --config=$config --installdeps=$missing" + : "\@\$(NOOP)" + ); + + return %args; +} + +# a wrapper to ExtUtils::MakeMaker::WriteMakefile +sub Write { + require Carp; + Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; + + if ($CheckOnly) { + print << "."; +*** Makefile not written in check-only mode. +. + return; + } + + my %args = _make_args(@_); + + no strict 'refs'; + + $PostambleUsed = 0; + local *MY::postamble = \&postamble unless defined &MY::postamble; + ExtUtils::MakeMaker::WriteMakefile(%args); + + print << "." unless $PostambleUsed; +*** WARNING: Makefile written with customized MY::postamble() without + including contents from ExtUtils::AutoInstall::postamble() -- + auto installation features disabled. Please contact the author. +. + + return 1; +} + +sub postamble { + $PostambleUsed = 1; + + return << "."; + +config :: installdeps +\t\@\$(NOOP) + +checkdeps :: +\t\$(PERL) $0 --checkdeps + +installdeps :: +\t$PostambleActions + +. + +} + +1; + +__END__ + +#line 929 diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm new file mode 100644 index 0000000..eeb4c1e --- /dev/null +++ b/inc/Module/Install.pm @@ -0,0 +1,171 @@ +#line 1 "inc/Module/Install.pm - /Library/Perl/5.8.1/Module/Install.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install.pm $ $Author: autrijus $ +# $Revision: #67 $ $Change: 1885 $ $DateTime: 2004/03/11 05:55:27 $ vim: expandtab shiftwidth=4 + +package Module::Install; +$VERSION = '0.33'; + +die << "." unless $INC{join('/', inc => split(/::/, __PACKAGE__)).'.pm'}; +Please invoke ${\__PACKAGE__} with: + + use inc::${\__PACKAGE__}; + +not: + + use ${\__PACKAGE__}; + +. + +use strict 'vars'; +use Cwd (); +use File::Find (); +use File::Path (); + +@inc::Module::Install::ISA = 'Module::Install'; + +#line 129 + +sub import { + my $class = shift; + my $self = $class->new(@_); + + if (not -f $self->{file}) { + require "$self->{path}/$self->{dispatch}.pm"; + File::Path::mkpath("$self->{prefix}/$self->{author}"); + $self->{admin} = + "$self->{name}::$self->{dispatch}"->new(_top => $self); + $self->{admin}->init; + @_ = ($class, _self => $self); + goto &{"$self->{name}::import"}; + } + + *{caller(0) . "::AUTOLOAD"} = $self->autoload; + + # Unregister loader and worker packages so subdirs can use them again + delete $INC{"$self->{file}"}; + delete $INC{"$self->{path}.pm"}; +} + +#line 156 + +sub autoload { + my $self = shift; + my $caller = caller; + + my $cwd = Cwd::cwd(); + my $sym = "$caller\::AUTOLOAD"; + + $sym->{$cwd} = sub { + my $pwd = Cwd::cwd(); + if (my $code = $sym->{$pwd}) { + goto &$code unless $cwd eq $pwd; # delegate back to parent dirs + } + $$sym =~ /([^:]+)$/ or die "Cannot autoload $caller"; + unshift @_, ($self, $1); + goto &{$self->can('call')} unless uc($1) eq $1; + }; +} + +#line 181 + +sub new { + my ($class, %args) = @_; + + return $args{_self} if $args{_self}; + + $args{dispatch} ||= 'Admin'; + $args{prefix} ||= 'inc'; + $args{author} ||= '.author'; + $args{bundle} ||= 'inc/BUNDLES'; + + $class =~ s/^\Q$args{prefix}\E:://; + $args{name} ||= $class; + $args{version} ||= $class->VERSION; + + unless ($args{path}) { + $args{path} = $args{name}; + $args{path} =~ s!::!/!g; + } + $args{file} ||= "$args{prefix}/$args{path}.pm"; + + bless(\%args, $class); +} + +#line 210 + +sub call { + my $self = shift; + my $method = shift; + my $obj = $self->load($method) or return; + + unshift @_, $obj; + goto &{$obj->can($method)}; +} + +#line 225 + +sub load { + my ($self, $method) = @_; + + $self->load_extensions( + "$self->{prefix}/$self->{path}", $self + ) unless $self->{extensions}; + + foreach my $obj (@{$self->{extensions}}) { + return $obj if $obj->can($method); + } + + my $admin = $self->{admin} or die << "END"; +The '$method' method does not exist in the '$self->{prefix}' path! +Please remove the '$self->{prefix}' directory and run $0 again to load it. +END + + my $obj = $admin->load($method, 1); + push @{$self->{extensions}}, $obj; + + $obj; +} + +#line 255 + +sub load_extensions { + my ($self, $path, $top_obj) = @_; + + unshift @INC, $self->{prefix} + unless grep { $_ eq $self->{prefix} } @INC; + + local @INC = ($path, @INC); + foreach my $rv ($self->find_extensions($path)) { + my ($file, $pkg) = @{$rv}; + next if $self->{pathnames}{$pkg}; + + eval { require $file; 1 } or (warn($@), next); + $self->{pathnames}{$pkg} = delete $INC{$file}; + push @{$self->{extensions}}, $pkg->new( _top => $top_obj ); + } +} + +#line 279 + +sub find_extensions { + my ($self, $path) = @_; + my @found; + + File::Find::find(sub { + my $file = $File::Find::name; + return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; + return if $1 eq $self->{dispatch}; + + $file = "$self->{path}/$1.pm"; + my $pkg = "$self->{name}::$1"; $pkg =~ s!/!::!g; + push @found, [$file, $pkg]; + }, $path) if -d $path; + + @found; +} + +1; + +__END__ + +#line 614 diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm new file mode 100644 index 0000000..c22821c --- /dev/null +++ b/inc/Module/Install/AutoInstall.pm @@ -0,0 +1,65 @@ +#line 1 "inc/Module/Install/AutoInstall.pm - /Library/Perl/5.8.1/Module/Install/AutoInstall.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install/AutoInstall.pm $ $Author: autrijus $ +# $Revision: #13 $ $Change: 1846 $ $DateTime: 2003/12/31 22:57:12 $ vim: expandtab shiftwidth=4 + +package Module::Install::AutoInstall; +use Module::Install::Base; @ISA = qw(Module::Install::Base); + +sub AutoInstall { $_[0] } + +sub run { + my $self = shift; + $self->auto_install_now(@_); +} + +sub write { + my $self = shift; + $self->auto_install(@_); +} + +sub auto_install { + my $self = shift; + return if $self->{done}++; + +# ExtUtils::AutoInstall Bootstrap Code, version 7. +AUTO:{my$p='ExtUtils::AutoInstall';my$v=0.49;$p->VERSION||0>=$v +or+eval"use $p $v;1"or+do{my$e=$ENV{PERL_EXTUTILS_AUTOINSTALL}; +(!defined($e)||$e!~m/--(?:default|skip|testonly)/and-t STDIN or +eval"use ExtUtils::MakeMaker;WriteMakefile(PREREQ_PM=>{'$p',$v} +);1"and exit)and print"==> $p $v required. Install it from CP". +"AN? [Y/n] "and<STDIN>!~/^n/i and print"*** Installing $p\n"and +do{if (eval '$>' and lc(`sudo -V`) =~ /version/){system('sudo', +$^X,"-MCPANPLUS","-e","CPANPLUS::install $p");eval"use $p $v;1" +||system('sudo', $^X, "-MCPAN", "-e", "CPAN::install $p")}eval{ +require CPANPLUS;CPANPLUS::install$p};eval"use $p $v;1"or eval{ +require CPAN;CPAN::install$p};eval"use $p $v;1"||die"*** Please +manually install $p $v from cpan.org first...\n"}}} + + # Flatten array of arrays into a single array + my @core = map @$_, map @$_, grep ref, + $self->build_requires, $self->requires; + + while ( @core and @_ > 1 and $_[0] =~ /^-\w+$/ ) { + push @core, splice(@_, 0, 2); + } + + ExtUtils::AutoInstall->import( + (@core ? (-core => \@core) : ()), @_, $self->features + ); + + $self->makemaker_args( ExtUtils::AutoInstall::_make_args() ); + + my $class = ref($self); + $self->postamble( + "# --- $class section:\n" . + ExtUtils::AutoInstall::postamble() + ); +} + +sub auto_install_now { + my $self = shift; + $self->auto_install; + ExtUtils::AutoInstall::do_install(); +} + +1; diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm new file mode 100644 index 0000000..ac43208 --- /dev/null +++ b/inc/Module/Install/Base.pm @@ -0,0 +1,57 @@ +#line 1 "inc/Module/Install/Base.pm - /Library/Perl/5.8.1/Module/Install/Base.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install/Base.pm $ $Author: autrijus $ +# $Revision: #10 $ $Change: 1847 $ $DateTime: 2003/12/31 23:14:54 $ vim: expandtab shiftwidth=4 + +package Module::Install::Base; + +#line 31 + +sub new { + my ($class, %args) = @_; + + foreach my $method (qw(call load)) { + *{"$class\::$method"} = sub { + +shift->_top->$method(@_); + } unless defined &{"$class\::$method"}; + } + + bless(\%args, $class); +} + +#line 49 + +sub AUTOLOAD { + my $self = shift; + goto &{$self->_top->autoload}; +} + +#line 60 + +sub _top { $_[0]->{_top} } + +#line 71 + +sub admin { + my $self = shift; + $self->_top->{admin} or Module::Install::Base::FakeAdmin->new; +} + +sub is_admin { + my $self = shift; + $self->admin->VERSION; +} + +sub DESTROY {} + +package Module::Install::Base::FakeAdmin; + +my $Fake; +sub new { $Fake ||= bless(\@_, $_[0]) } +sub AUTOLOAD {} +sub DESTROY {} + +1; + +__END__ + +#line 115 diff --git a/inc/Module/Install/Build.pm b/inc/Module/Install/Build.pm new file mode 100644 index 0000000..6fb595e --- /dev/null +++ b/inc/Module/Install/Build.pm @@ -0,0 +1,66 @@ +#line 1 "inc/Module/Install/Build.pm - /Library/Perl/5.8.1/Module/Install/Build.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install/Build.pm $ $Author: ingy $ +# $Revision: #23 $ $Change: 1255 $ $DateTime: 2003/03/05 13:23:32 $ vim: expandtab shiftwidth=4 + +package Module::Install::Build; +$VERSION = '0.01'; +use strict; +use vars qw(@ISA); +use Module::Install::Base; @ISA = qw(Module::Install::Base); + +sub Build { $_[0] } + +sub write { + my $self = shift; + die "Build->write() takes no arguments\n" if @_; + + my %args; + my $build; + + $args{dist_name} = $self->name || $self->determine_NAME($self->{args}); + $args{license} = $self->license; + $args{dist_version} = $self->version || $self->determine_VERSION($self->{args}); + $args{dist_abstract} = $self->abstract; + $args{dist_author} = $self->author; + $args{sign} = $self->sign; + $args{no_index} = $self->no_index; + + foreach my $key (qw(build_requires requires recommends conflicts)) { + my $val = eval "\$self->$key" or next; + $args{$key} = { map @$_, @$val }; + } + + %args = map {($_, $args{$_})} grep {defined($args{$_})} keys %args; + + require Module::Build; + $build = Module::Build->new(%args); + $build->add_to_cleanup(split /\s+/, $self->clean_files); + $build->create_build_script; +} + +sub ACTION_reset { + my ($self) = @_; + die "XXX - Can't get this working yet"; + require File::Path; + warn "Removing inc\n"; + rmpath('inc'); +} + +sub ACTION_dist { + my ($self) = @_; + die "XXX - Can't get this working yet"; +} + +# <ingy> DrMath: is there an OO way to add actions to Module::Build?? +# <DrMath> ingy: yeah +# <DrMath> ingy: package MyBuilder; use w(Module::Build; @ISA = qw(w(Module::Build); sub ACTION_ingy +# {...} +# <DrMath> ingy: then my $build = new MyBuilder( ...parameters... ); +# $build->write_build_script; + + +1; + +__END__ + +#line 178 diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm new file mode 100644 index 0000000..fe6ac24 --- /dev/null +++ b/inc/Module/Install/Can.pm @@ -0,0 +1,41 @@ +#line 1 "inc/Module/Install/Can.pm - /Library/Perl/5.8.1/Module/Install/Can.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install/Can.pm $ $Author: autrijus $ +# $Revision: #6 $ $Change: 1840 $ $DateTime: 2003/12/28 19:42:02 $ vim: expandtab shiftwidth=4 + +package Module::Install::Can; +use Module::Install::Base; @ISA = qw(Module::Install::Base); +$VERSION = '0.01'; + +use strict; +use Config (); +use File::Spec (); +use ExtUtils::MakeMaker (); + +# check if we can run some command +sub can_run { + my ($self, $cmd) = @_; + + my $_cmd = $cmd; + return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); + + for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { + my $abs = File::Spec->catfile($dir, $_[1]); + return $abs if (-x $abs or $abs = MM->maybe_command($abs)); + } + + return; +} + +sub can_cc { + my $self = shift; + my @chunks = split(/ /, $Config::Config{cc}) or return; + + # $Config{cc} may contain args; try to find out the program part + while (@chunks) { + return $self->can_run("@chunks") || (pop(@chunks), next); + } + + return; +} + +1; diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm new file mode 100644 index 0000000..6c9a1d7 --- /dev/null +++ b/inc/Module/Install/Fetch.pm @@ -0,0 +1,89 @@ +#line 1 "inc/Module/Install/Fetch.pm - /Library/Perl/5.8.1/Module/Install/Fetch.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install/Fetch.pm $ $Author: autrijus $ +# $Revision: #8 $ $Change: 1374 $ $DateTime: 2003/03/18 11:50:15 $ vim: expandtab shiftwidth=4 + +package Module::Install::Fetch; +use Module::Install::Base; @ISA = qw(Module::Install::Base); + +$VERSION = '0.01'; + +sub get_file { + my ($self, %args) = @_; + my ($scheme, $host, $path, $file) = + $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; + + if ($scheme eq 'http' and !eval { require LWP::Simple; 1 }) { + $args{url} = $args{ftp_url} + or (warn("LWP support unavailable!\n"), return); + ($scheme, $host, $path, $file) = + $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; + } + + $|++; + print "Fetching '$file' from $host... "; + + unless (eval { require Socket; Socket::inet_aton($host) }) { + warn "'$host' resolve failed!\n"; + return; + } + + return unless $scheme eq 'ftp' or $scheme eq 'http'; + + require Cwd; + my $dir = Cwd::getcwd(); + chdir $args{local_dir} or return if exists $args{local_dir}; + + if (eval { require LWP::Simple; 1 }) { + LWP::Simple::mirror($args{url}, $file); + } + elsif (eval { require Net::FTP; 1 }) { eval { + # use Net::FTP to get past firewall + my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); + $ftp->login("anonymous", 'anonym...@example.com'); + $ftp->cwd($path); + $ftp->binary; + $ftp->get($file) or (warn("$!\n"), return); + $ftp->quit; + } } + elsif (my $ftp = $self->can_run('ftp')) { eval { + # no Net::FTP, fallback to ftp.exe + require FileHandle; + my $fh = FileHandle->new; + + local $SIG{CHLD} = 'IGNORE'; + unless ($fh->open("|$ftp -n")) { + warn "Couldn't open ftp: $!\n"; + chdir $dir; return; + } + + my @dialog = split(/\n/, << "."); +open $host +user anonymous anonymous\@example.com +cd $path +binary +get $file $file +quit +. + foreach (@dialog) { $fh->print("$_\n") } + $fh->close; + } } + else { + warn "No working 'ftp' program available!\n"; + chdir $dir; return; + } + + unless (-f $file) { + warn "Fetching failed: $@\n"; + chdir $dir; return; + } + + return if exists $args{size} and -s $file != $args{size}; + system($args{run}) if exists $args{run}; + unlink($file) if $args{remove}; + + print(((!exists $args{check_for} or -e $args{check_for}) + ? "done!" : "failed! ($!)"), "\n"); + chdir $dir; return !$?; +} + +1; diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm new file mode 100644 index 0000000..6adef92 --- /dev/null +++ b/inc/Module/Install/Include.pm @@ -0,0 +1,12 @@ +#line 1 "inc/Module/Install/Include.pm - /Library/Perl/5.8.1/Module/Install/Include.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install/Include.pm $ $Author: autrijus $ +# $Revision: #8 $ $Change: 1811 $ $DateTime: 2003/12/14 18:52:33 $ vim: expandtab shiftwidth=4 + +package Module::Install::Include; +use Module::Install::Base; @ISA = qw(Module::Install::Base); + +sub include { +shift->admin->include(@_) }; +sub include_deps { +shift->admin->include_deps(@_) }; +sub auto_include { +shift->admin->auto_include(@_) }; + +1; diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm new file mode 100644 index 0000000..41dff0c --- /dev/null +++ b/inc/Module/Install/Makefile.pm @@ -0,0 +1,146 @@ +#line 1 "inc/Module/Install/Makefile.pm - /Library/Perl/5.8.1/Module/Install/Makefile.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install/Makefile.pm $ $Author: autrijus $ +# $Revision: #53 $ $Change: 1847 $ $DateTime: 2003/12/31 23:14:54 $ vim: expandtab shiftwidth=4 + +package Module::Install::Makefile; +use Module::Install::Base; @ISA = qw(Module::Install::Base); + +$VERSION = '0.01'; + +use strict 'vars'; +use vars '$VERSION'; + +use ExtUtils::MakeMaker (); + +sub Makefile { $_[0] } + +sub prompt { + shift; + goto &ExtUtils::MakeMaker::prompt; +} + +sub makemaker_args { + my $self = shift; + my $args = ($self->{makemaker_args} ||= {}); + %$args = ( %$args, @_ ) if @_; + $args; +} + +sub clean_files { + my $self = shift; + my $clean = $self->makemaker_args->{clean} ||= {}; + %$clean = ( + %$clean, + FILES => join(" ", grep length, $clean->{FILES}, @_), + ); +} + +sub libs { + my $self = shift; + my $libs = ref $_[0] ? shift : [shift]; + $self->makemaker_args( LIBS => $libs ); +} + +sub inc { + my $self = shift; + $self->makemaker_args( INC => shift ); +} + +sub write { + my $self = shift; + die "&Makefile->write() takes no arguments\n" if @_; + + my $args = $self->makemaker_args; + + $args->{DISTNAME} = $self->name; + $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); + $args->{VERSION} = $self->version || $self->determine_VERSION($args); + $args->{NAME} =~ s/-/::/g; + + if ($] >= 5.005) { + $args->{ABSTRACT} = $self->abstract; + $args->{AUTHOR} = $self->author; + } + if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { + $args->{NO_META} = 1; + } + if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 ) { + $args->{SIGN} = 1 if $self->sign; + } + delete $args->{SIGN} unless $self->is_admin; + + # merge both kinds of requires into prereq_pm + my $prereq = ($args->{PREREQ_PM} ||= {}); + %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, + ($self->build_requires, $self->requires) ); + + # merge both kinds of requires into prereq_pm + my $dir = ($args->{DIR} ||= []); + if ($self->bundles) { + push @$dir, map "$_->[1]", @{$self->bundles}; + delete $prereq->{$_->[0]} for @{$self->bundles}; + } + + if (my $perl_version = $self->perl_version) { + eval "use $perl_version; 1" + or die "ERROR: perl: Version $] is installed, ". + "but we need version >= $perl_version"; + } + + my %args = map {($_ => $args->{$_})} grep {defined($args->{$_})} keys %$args; + + if ($self->admin->preop) { + $args{dist} = $self->admin->preop; + } + + ExtUtils::MakeMaker::WriteMakefile(%args); + + $self->fix_up_makefile(); +} + +sub fix_up_makefile { + my $self = shift; + my $top_class = ref($self->_top) || ''; + my $top_version = $self->_top->VERSION || ''; + + my $preamble = $self->preamble + ? "# Preamble by $top_class $top_version\n" . $self->preamble + : ''; + my $postamble = "# Postamble by $top_class $top_version\n" . + ($self->postamble || ''); + + open MAKEFILE, '< Makefile' or die $!; + my $makefile = do { local $/; <MAKEFILE> }; + close MAKEFILE; + + $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; + $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; + $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; + + $makefile =~ s/^(FULLPERL = .*)/$1 -Iinc/m; + $makefile =~ s/^(PERL = .*)/$1 -Iinc/m; + + open MAKEFILE, '> Makefile' or die $!; + print MAKEFILE "$preamble$makefile$postamble"; + close MAKEFILE; +} + +sub preamble { + my ($self, $text) = @_; + $self->{preamble} = $text . $self->{preamble} if defined $text; + $self->{preamble}; +} + +sub postamble { + my ($self, $text) = @_; + + $self->{postamble} ||= $self->admin->postamble; + $self->{postamble} .= $text if defined $text; + $self->{postamble} +} + +1; + +__END__ + +#line 276 diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm new file mode 100644 index 0000000..b966264 --- /dev/null +++ b/inc/Module/Install/Metadata.pm @@ -0,0 +1,190 @@ +#line 1 "inc/Module/Install/Metadata.pm - /Library/Perl/5.8.1/Module/Install/Metadata.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install/Metadata.pm $ $Author: autrijus $ +# $Revision: #32 $ $Change: 1885 $ $DateTime: 2004/03/11 05:55:27 $ vim: expandtab shiftwidth=4 + +package Module::Install::Metadata; +use Module::Install::Base; @ISA = qw(Module::Install::Base); + +$VERSION = '0.04'; + +use strict 'vars'; +use vars qw($VERSION); + +sub Meta { shift } + +my @scalar_keys = qw( + name module_name version abstract author license + distribution_type sign perl_version +); +my @tuple_keys = qw(build_requires requires recommends bundles); + +foreach my $key (@scalar_keys) { + *$key = sub { + my $self = shift; + return $self->{'values'}{$key} unless @_; + $self->{'values'}{$key} = shift; + return $self; + }; +} + +foreach my $key (@tuple_keys) { + *$key = sub { + my $self = shift; + return $self->{'values'}{$key} unless @_; + my @rv; + while (@_) { + my $module = shift or last; + my $version = shift || 0; + if ($module eq 'perl') { + $version =~ s{^(\d+)\.(\d+)\.(\d+)} + {$1 + $2/1_000 + $3/1_000_000}e; + $self->perl_version($version); + next; + } + my $rv = [$module, $version]; + push @{$self->{'values'}{$key}}, $rv; + push @rv, $rv; + } + return @rv; + }; +} + +sub features { + my $self = shift; + while (my ($name, $mods) = splice(@_, 0, 2)) { + my $count = 0; + push @{$self->{'values'}{'features'}}, ($name => [ + map { (++$count % 2 and ref($_) and ($count += $#$_)) ? @$_ : $_ } @$mods + ] ); + } + return @{$self->{'values'}{'features'}}; +} + +sub no_index { + my $self = shift; + my $type = shift; + push @{$self->{'values'}{'no_index'}{$type}}, @_ if $type; + return $self->{'values'}{'no_index'}; +} + +sub _dump { + my $self = shift; + my $package = ref($self->_top); + my $version = $self->_top->VERSION; + my %values = %{$self->{'values'}}; + + delete $values{sign}; + if (my $perl_version = delete $values{perl_version}) { + # Always canonical to three-dot version + $perl_version =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2), int($3))}e + if $perl_version >= 5.006; + $values{requires} = [ + [perl => $perl_version], + @{$values{requires}||[]}, + ]; + } + + warn "No license specified, setting license = 'unknown'\n" + unless $values{license}; + + $values{license} ||= 'unknown'; + $values{distribution_type} ||= 'module'; + $values{name} ||= do { + my $name = $values{module_name}; + $name =~ s/::/-/g; + $name; + } if $values{module_name}; + + if ($values{name} =~ /::/) { + my $name = $values{name}; + $name =~ s/::/-/g; + die "Error in name(): '$values{name}' should be '$name'!\n"; + } + + my $dump = ''; + foreach my $key (@scalar_keys) { + $dump .= "$key: $values{$key}\n" if exists $values{$key}; + } + foreach my $key (@tuple_keys) { + next unless exists $values{$key}; + $dump .= "$key:\n"; + foreach (@{$values{$key}}) { + $dump .= " $_->[0]: $_->[1]\n"; + } + } + + if (my $no_index = $values{no_index}) { + push @{$no_index->{'directory'}}, 'inc'; + require YAML; + local $YAML::UseHeader = 0; + $dump .= YAML::Dump({ no_index => $no_index}); + } + else { + $dump .= << "META"; +no_index: + directory: + - inc +META + } + + $dump .= "generated_by: $package version $version\n"; + return $dump; +} + +sub read { + my $self = shift; + $self->include_deps( 'YAML', 0 ); + require YAML; + my $data = YAML::LoadFile( 'META.yml' ); + # Call methods explicitly in case user has already set some values. + while ( my ($key, $value) = each %$data ) { + next unless $self->can( $key ); + if (ref $value eq 'HASH') { + while (my ($module, $version) = each %$value) { + $self->$key( $module => $version ); + } + } + else { + $self->$key( $value ); + } + } + return $self; +} + +sub write { + my $self = shift; + return $self unless $self->is_admin; + + META_NOT_OURS: { + local *FH; + if (open FH, "META.yml") { + while (<FH>) { + last META_NOT_OURS if /^generated_by: Module::Install\b/; + } + return $self if -s FH; + } + } + + warn "Writing META.yml\n"; + open META, "> META.yml" or warn "Cannot write to META.yml: $!"; + print META $self->_dump; + close META; + return $self; +} + +sub version_from { + my ($self, $version_from) = @_; + require ExtUtils::MM_Unix; + $self->version(ExtUtils::MM_Unix->parse_version($version_from)); +} + +sub abstract_from { + my ($self, $abstract_from) = @_; + require ExtUtils::MM_Unix; + $self->abstract( + bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix') + ->parse_abstract($abstract_from) + ); +} + +1; diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm new file mode 100644 index 0000000..a72d8ed --- /dev/null +++ b/inc/Module/Install/Win32.pm @@ -0,0 +1,66 @@ +#line 1 "inc/Module/Install/Win32.pm - /Library/Perl/5.8.1/Module/Install/Win32.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install/Win32.pm $ $Author: autrijus $ +# $Revision: #9 $ $Change: 1789 $ $DateTime: 2003/11/11 01:22:54 $ vim: expandtab shiftwidth=4 + +package Module::Install::Win32; +use Module::Install::Base; @ISA = qw(Module::Install::Base); + +$VERSION = '0.02'; + +use strict; + +# determine if the user needs nmake, and download it if needed +sub check_nmake { + my $self = shift; + $self->load('can_run'); + $self->load('get_file'); + + require Config; + return unless ( + $Config::Config{make} and + $Config::Config{make} =~ /^nmake\b/i and + $^O eq 'MSWin32' and + !$self->can_run('nmake') + ); + + print "The required 'nmake' executable not found, fetching it...\n"; + + require File::Basename; + my $rv = $self->get_file( + url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', + ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', + local_dir => File::Basename::dirname($^X), + size => 51928, + run => 'Nmake15.exe /o > nul', + check_for => 'Nmake.exe', + remove => 1, + ); + + if (!$rv) { + die << '.'; + +------------------------------------------------------------------------------- + +Since you are using Microsoft Windows, you will need the 'nmake' utility +before installation. It's available at: + + http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe + or + ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe + +Please download the file manually, save it to a directory in %PATH% (e.g. +C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to +that directory, and run "Nmake15.exe" from there; that will create the +'nmake.exe' file needed by this module. + +You may then resume the installation process described in README. + +------------------------------------------------------------------------------- +. + } +} + +1; + +__END__ + diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm new file mode 100644 index 0000000..8418d98 --- /dev/null +++ b/inc/Module/Install/WriteAll.pm @@ -0,0 +1,39 @@ +#line 1 "inc/Module/Install/WriteAll.pm - /Library/Perl/5.8.1/Module/Install/WriteAll.pm" +# $File: //depot/cpan/Module-Install/lib/Module/Install/WriteAll.pm $ $Author: autrijus $ +# $Revision: #3 $ $Change: 1885 $ $DateTime: 2004/03/11 05:55:27 $ vim: expandtab shiftwidth=4 + +package Module::Install::WriteAll; +use Module::Install::Base; @ISA = qw(Module::Install::Base); + +sub WriteAll { + my $self = shift; + my %args = ( + meta => 1, + sign => 0, + inline => 0, + check_nmake => 1, + @_ + ); + + $self->sign(1) if $args{sign}; + $self->Meta->write if $args{meta}; + $self->admin->WriteAll(%args) if $self->is_admin; + + if ($0 =~ /Build.PL$/i) { + $self->Build->write; + } + else { + $self->check_nmake if $args{check_nmake}; + $self->makemaker_args( PL_FILES => {} ) + unless $self->makemaker_args->{'PL_FILES'}; + + if ($args{inline}) { + $self->Inline->write; + } + else { + $self->Makefile->write; + } + } +} + +1; diff --git a/lib/Class/ErrorHandler.pm b/lib/Class/ErrorHandler.pm new file mode 100644 index 0000000..20c82eb --- /dev/null +++ b/lib/Class/ErrorHandler.pm @@ -0,0 +1,100 @@ +# $Id: ErrorHandler.pm,v 1.1.1.1 2004/08/15 14:55:43 btrott Exp $ + +package Class::ErrorHandler; +use strict; + +use vars qw( $VERSION $ERROR ); +$VERSION = '0.01'; + +sub error { + my $msg = $_[1] || ''; + if (ref($_[0])) { + $_[0]->{_errstr} = $msg; + } else { + $ERROR = $msg; + } + return; +} + +sub errstr { + ref($_[0]) ? $_[0]->{_errstr} : $ERROR +} + +1; +__END__ + +=head1 NAME + +Class::ErrorHandler - Base class for error handling + +=head1 SYNOPSIS + + package Foo; + use base qw( Class::ErrorHandler ); + + sub class_method { + my $class = shift; + ... + return $class->error("Help!") + unless $continue; + } + + sub object_method { + my $obj = shift; + ... + return $obj->error("I am no more") + unless $continue; + } + + package main; + use Foo; + + Foo->class_method or die Foo->errstr; + + my $foo = Foo->new; + $foo->object_method or die $foo->errstr; + +=head1 DESCRIPTION + +I<Class::ErrorHandler> provides an error-handling mechanism that's generic +enough to be used as the base class for a variety of OO classes. Subclasses +inherit its two error-handling methods, I<error> and I<errstr>, to +communicate error messages back to the calling program. + +On failure (for whatever reason), a subclass should call I<error> and return +to the caller; I<error> itself sets the error message internally, then +returns C<undef>. This has the effect of the method that failed returning +C<undef> to the caller. The caller should check for errors by checking for a +return value of C<undef>, and calling I<errstr> to get the value of the +error message on an error. + +As demonstrated in the L<SYNOPSIS>, I<error> and I<errstr> work as both class +methods and object methods. + +=head1 USAGE + +=head2 Class->error($message) + +=head2 $object->error($message) + +Sets the error message for either the class I<Class> or the object +I<$object> to the message I<$message>. Returns C<undef>. + +=head2 Class->errstr + +=head2 $object->errstr + +Accesses the last error message set in the class I<Class> or the +object I<$object>, respectively, and returns that error message. + +=head1 LICENSE + +I<Class::ErrorHandler> is free software; you may redistribute it and/or modify +it under the same terms as Perl itself. + +=head1 AUTHOR & COPYRIGHT + +Except where otherwise noted, I<Class::ErrorHandler> is Copyright 2004 +Benjamin Trott, c...@stupidfool.org. All rights reserved. + +=cut diff --git a/t/00-compile.t b/t/00-compile.t new file mode 100644 index 0000000..bdece98 --- /dev/null +++ b/t/00-compile.t @@ -0,0 +1,8 @@ +# $Id: 00-compile.t,v 1.1.1.1 2004/08/15 14:55:43 btrott Exp $ + +my $loaded; +BEGIN { print "1..1\n" } +use Class::ErrorHandler; +$loaded++; +print "ok 1\n"; +END { print "not ok 1\n" unless $loaded } diff --git a/t/01-errors.t b/t/01-errors.t new file mode 100644 index 0000000..5e30806 --- /dev/null +++ b/t/01-errors.t @@ -0,0 +1,26 @@ +# $Id: 01-errors.t,v 1.1.1.1 2004/08/15 14:55:43 btrott Exp $ + +use strict; +use Test; + +BEGIN { plan tests => 9 }; + +my $eh = My::Class->new; +ok($eh); +my $val = $eh->error('foo bar'); +ok(!defined $val); +ok($eh->errstr eq "foo bar"); +my @val = $eh->error('foo'); +ok(@val == 0); +ok($eh->errstr eq "foo"); + +$val = My::Class->error('foo bar'); +ok(!defined $val); +ok(My::Class->errstr eq "foo bar"); +@val = My::Class->error('foo'); +ok(@val == 0); +ok(My::Class->errstr eq "foo"); + +package My::Class; +use base qw( Class::ErrorHandler ); +sub new { bless { }, shift } -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libclass-errorhandler-perl.git _______________________________________________ Pkg-perl-cvs-commits mailing list Pkg-perl-cvs-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits