[Rt-commit] [svn] r1011 - in mzscheme: . Inline-MzScheme
Inline-MzScheme/inc Inline-MzScheme/inc/.author
Inline-MzScheme/inc/Module Inline-MzScheme/inc/Module/Install
Inline-MzScheme/lib Inline-MzScheme/lib/Inline
Inline-MzScheme/t Language-MzScheme/lib/Language
autrijus at pallas.eruditorum.org
autrijus at pallas.eruditorum.org
Mon Jun 7 00:37:57 EDT 2004
Author: autrijus
Date: Mon Jun 7 00:37:57 2004
New Revision: 1011
Added:
mzscheme/Inline-MzScheme/
mzscheme/Inline-MzScheme/Changes
mzscheme/Inline-MzScheme/MANIFEST
mzscheme/Inline-MzScheme/MANIFEST.SKIP
mzscheme/Inline-MzScheme/META.yml
mzscheme/Inline-MzScheme/Makefile.PL
mzscheme/Inline-MzScheme/README
mzscheme/Inline-MzScheme/SIGNATURE
mzscheme/Inline-MzScheme/inc/
mzscheme/Inline-MzScheme/inc/.author/
mzscheme/Inline-MzScheme/inc/Module/
mzscheme/Inline-MzScheme/inc/Module/Install/
mzscheme/Inline-MzScheme/inc/Module/Install.pm
mzscheme/Inline-MzScheme/inc/Module/Install/Base.pm
mzscheme/Inline-MzScheme/inc/Module/Install/Can.pm
mzscheme/Inline-MzScheme/inc/Module/Install/Fetch.pm
mzscheme/Inline-MzScheme/inc/Module/Install/Makefile.pm
mzscheme/Inline-MzScheme/inc/Module/Install/Metadata.pm
mzscheme/Inline-MzScheme/inc/Module/Install/Win32.pm
mzscheme/Inline-MzScheme/inc/Module/Install/WriteAll.pm
mzscheme/Inline-MzScheme/lib/
mzscheme/Inline-MzScheme/lib/Inline/
mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm
mzscheme/Inline-MzScheme/t/
mzscheme/Inline-MzScheme/t/0-signature.t
mzscheme/Inline-MzScheme/t/1-basic.t
Modified:
mzscheme/ (props changed)
mzscheme/Language-MzScheme/lib/Language/MzScheme.pm
Log:
----------------------------------------------------------------------
r5440 at not: autrijus | 2004-06-07T04:38:05.482402Z
* Inline::MzScheme, 0.01.
* Modify Language::MzScheme to refer to Inline::MzScheme and correct copyright.
----------------------------------------------------------------------
Added: mzscheme/Inline-MzScheme/Changes
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/Changes Mon Jun 7 00:37:57 2004
@@ -0,0 +1,5 @@
+Revision history for Perl extension Inline::Guile.
+
+0.001 Sat Jul 22 12:00:00 2001
+ - First version released!
+
Added: mzscheme/Inline-MzScheme/MANIFEST
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/MANIFEST Mon Jun 7 00:37:57 2004
@@ -0,0 +1,18 @@
+Changes
+inc/Module/Install.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/Inline/MzScheme.pm
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.SKIP
+META.yml
+README
+SIGNATURE
+t/0-signature.t
+t/1-basic.t
Added: mzscheme/Inline-MzScheme/MANIFEST.SKIP
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/MANIFEST.SKIP Mon Jun 7 00:37:57 2004
@@ -0,0 +1,18 @@
+#defaults
+\bRCS\b
+\bCVS\b
+,v$
+\B\.svn\b
+^MANIFEST\.bak
+^Makefile$
+^blib/
+^bin/
+^MakeMaker-\d
+^.*\.hi
+^_Inline
+^blibdirs
+^pm_to_blib
+~$
+\.old$
+^#.*#$
+^\.#
Added: mzscheme/Inline-MzScheme/META.yml
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/META.yml Mon Jun 7 00:37:57 2004
@@ -0,0 +1,14 @@
+name: Inline-MzScheme
+version: 0.01
+abstract: Inline module for the PLT MzScheme interpreter
+author: Autrijus Tang <autrijus at autrijus.org>
+license: perl
+distribution_type: module
+requires:
+ Inline: 0.43
+ Language::MzScheme: 0.01
+ Scalar::Util: 0.01
+no_index:
+ directory:
+ - inc
+generated_by: Module::Install version 0.33
Added: mzscheme/Inline-MzScheme/Makefile.PL
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/Makefile.PL Mon Jun 7 00:37:57 2004
@@ -0,0 +1,18 @@
+#!/usr/bin/perl
+
+use strict;
+use inc::Module::Install;
+
+name('Inline-MzScheme');
+version_from('lib/Inline/MzScheme.pm');
+abstract_from('lib/Inline/MzScheme.pm');
+author('Autrijus Tang <autrijus at autrijus.org>');
+license('perl');
+requires(qw(
+ Inline 0.43
+ Language::MzScheme 0.01
+ Scalar::Util 0.01
+));
+can_cc() or die "This module requires a C compiler";
+
+WriteAll( sign => 1 );
Added: mzscheme/Inline-MzScheme/README
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/README Mon Jun 7 00:37:57 2004
@@ -0,0 +1,30 @@
+This is the README file for Language::MzScheme, a module that
+provides Perl bindings to PLT MzScheme.
+
+Please type "perldoc Language::MzScheme" after installation to
+see the module usage information.
+
+* Prerequisites
+
+- The C++ Compiler used to compile your perl installation
+- SWIG - http://www.swig.org/
+- MzScheme - http://plt-scheme.org/software/mzscheme/
+
+* Installation
+
+Language::MzScheme uses the standard perl module install process:
+
+cpansign -v # optional; see SIGNATURE for details
+perl Makefile.PL
+make # or 'nmake' on Win32
+make test
+make install
+
+* Copyright
+
+Copyright 2004 by Autrijus Tang <autrijus at autrijus.org>.
+
+All rights reserved. You can redistribute and/or modify
+this bundle under the same terms as Perl itself.
+
+See <http://www.perl.com/perl/misc/Artistic.html>.
Added: mzscheme/Inline-MzScheme/SIGNATURE
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/SIGNATURE Mon Jun 7 00:37:57 2004
@@ -0,0 +1,40 @@
+This file contains message digests of all files listed in MANIFEST,
+signed via the Module::Signature module, version 0.38.
+
+To verify the content in this distribution, first make sure you have
+Module::Signature installed, then type:
+
+ % cpansign -v
+
+It would check each file's integrity, as well as the signature's
+validity. If "==> Signature verified OK! <==" is not displayed,
+the distribution may already have been compromised, and you should
+not run its Makefile.PL or Build.PL.
+
+-----BEGIN PGP SIGNED MESSAGE-----
+Hash: SHA1
+
+SHA1 a670ed48d5a8a61fca5d8f008aec8f1b91aee1ec Changes
+SHA1 3ccdfbd7b06ce8f3703e818323d7aba879102d8b MANIFEST
+SHA1 507a90272299ca2360c61c257b410a2b0d82dbbd MANIFEST.SKIP
+SHA1 2da13213a5d534f772bd72063314c31fd3eb2fed META.yml
+SHA1 076ef2300e026c01506733107748eecd390571f2 Makefile.PL
+SHA1 015ef794b70a926280cbbe8c8d34c1e1329896df README
+SHA1 2b65fc08c268c16ae7097d800bacccc7b8c9c905 inc/Module/Install.pm
+SHA1 fd56d5c793014bccac2cd1e61926c4da8538ef99 inc/Module/Install/Base.pm
+SHA1 9ce6768a7b8f7032ec89594b773fafd58c6feb1d inc/Module/Install/Can.pm
+SHA1 b6c8f0f22c4c8ba48a7bac2c5e4bd61803a7b097 inc/Module/Install/Fetch.pm
+SHA1 aabcd47178e4e7b27e340ff5273269c93697c9c1 inc/Module/Install/Makefile.pm
+SHA1 207dfa13341a374fc78325fbeb99bc36659aef2d inc/Module/Install/Metadata.pm
+SHA1 aff9341a15c04faec47089851e43d9d4061337e7 inc/Module/Install/Win32.pm
+SHA1 8e0d347ca21bc18b380d9d1aa5910b8d078a76b7 inc/Module/Install/WriteAll.pm
+SHA1 25ca3f98c9fd8c036c648a3ffe24f93c37dfaf94 lib/Inline/MzScheme.pm
+SHA1 63c7ea0cfdd7643aa113c260eec9c9bf0a6ee8a0 t/0-signature.t
+SHA1 9f4aeb17d8e74dd434b37e5d6e35c2fd82f67df3 t/1-basic.t
+-----BEGIN PGP SIGNATURE-----
+Version: GnuPG v1.2.3 (FreeBSD)
+
+iD8DBQFAw/CLtLPdNzw1AaARAnniAJ9I4b9HkwP1WPR1hLLJ6PkF/1ls9ACfdVYS
+W66J5730Qiy91h3nwOnT5Fg=
+=Kzps
+-----END PGP SIGNATURE-----
Added: mzscheme/Inline-MzScheme/inc/Module/Install.pm
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/inc/Module/Install.pm Mon Jun 7 00:37:57 2004
@@ -0,0 +1,171 @@
+#line 1 "inc/Module/Install.pm - /usr/local/lib/perl5/site_perl/5.8.4/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 ();
+
+ at 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
Added: mzscheme/Inline-MzScheme/inc/Module/Install/Base.pm
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/inc/Module/Install/Base.pm Mon Jun 7 00:37:57 2004
@@ -0,0 +1,57 @@
+#line 1 "inc/Module/Install/Base.pm - /usr/local/lib/perl5/site_perl/5.8.4/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
Added: mzscheme/Inline-MzScheme/inc/Module/Install/Can.pm
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/inc/Module/Install/Can.pm Mon Jun 7 00:37:57 2004
@@ -0,0 +1,41 @@
+#line 1 "inc/Module/Install/Can.pm - /usr/local/lib/perl5/site_perl/5.8.4/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;
Added: mzscheme/Inline-MzScheme/inc/Module/Install/Fetch.pm
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/inc/Module/Install/Fetch.pm Mon Jun 7 00:37:57 2004
@@ -0,0 +1,89 @@
+#line 1 "inc/Module/Install/Fetch.pm - /usr/local/lib/perl5/site_perl/5.8.4/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", 'anonymous at 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;
Added: mzscheme/Inline-MzScheme/inc/Module/Install/Makefile.pm
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/inc/Module/Install/Makefile.pm Mon Jun 7 00:37:57 2004
@@ -0,0 +1,146 @@
+#line 1 "inc/Module/Install/Makefile.pm - /usr/local/lib/perl5/site_perl/5.8.4/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
Added: mzscheme/Inline-MzScheme/inc/Module/Install/Metadata.pm
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/inc/Module/Install/Metadata.pm Mon Jun 7 00:37:57 2004
@@ -0,0 +1,190 @@
+#line 1 "inc/Module/Install/Metadata.pm - /usr/local/lib/perl5/site_perl/5.8.4/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;
Added: mzscheme/Inline-MzScheme/inc/Module/Install/Win32.pm
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/inc/Module/Install/Win32.pm Mon Jun 7 00:37:57 2004
@@ -0,0 +1,66 @@
+#line 1 "inc/Module/Install/Win32.pm - /usr/local/lib/perl5/site_perl/5.8.4/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__
+
Added: mzscheme/Inline-MzScheme/inc/Module/Install/WriteAll.pm
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/inc/Module/Install/WriteAll.pm Mon Jun 7 00:37:57 2004
@@ -0,0 +1,39 @@
+#line 1 "inc/Module/Install/WriteAll.pm - /usr/local/lib/perl5/site_perl/5.8.4/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;
Added: mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/lib/Inline/MzScheme.pm Mon Jun 7 00:37:57 2004
@@ -0,0 +1,149 @@
+package Inline::MzScheme;
+$Inline::MzScheme::VERSION = '0.01';
+ at Inline::MzScheme::ISA = qw(Inline);
+
+use strict;
+
+use Inline ();
+use Scalar::Util ();
+use Language::MzScheme ();
+use Carp qw(croak confess);
+
+=head1 NAME
+
+Inline::MzScheme - Inline module for the PLT MzScheme interpreter
+
+=head1 SYNOPSIS
+
+ use Inline MzScheme => '(define (square x) (* x x))';
+ print square(10); # 100
+
+=head1 DESCRIPTION
+
+This module allows you to add blocks of Scheme code to your Perl
+scripts and modules. Any procedures you define in your Scheme code
+will be available in Perl.
+
+For information about handling MzScheme data in Perl, please see
+L<Language::MzScheme>. This module is mostly a wrapper around
+L<Language::MzScheme::scheme_eval_string> with a little auto-binding
+magic for procedures and input variables.
+
+=cut
+
+# register for Inline
+sub register {
+ return {
+ language => 'MzScheme',
+ aliases => ['MZSCHEME'],
+ type => 'interpreted',
+ suffix => 'go',
+ };
+}
+
+# check options
+sub validate {
+ my $self = shift;
+
+ while (@_ >= 2) {
+ my ($key, $value) = (shift, shift);
+ croak("Unsupported option found: \"$key\".");
+ }
+}
+
+# required method - doesn't do anything useful
+sub build {
+ my $self = shift;
+
+ # magic dance steps to a successful Inline compile...
+ my $path = "$self->{API}{install_lib}/auto/$self->{API}{modpname}";
+ my $obj = $self->{API}{location};
+ $self->mkpath($path) unless -d $path;
+ $self->mkpath($self->{API}{build_dir}) unless -d $self->{API}{build_dir};
+
+ # touch my monkey
+ open(OBJECT, ">$obj") or die "Unable to open object file: $obj : $!";
+ close(OBJECT) or die "Unable to close object file: $obj : $!";
+}
+
+my $block;
+$block = qr/(\((?:(?>[^()]+)|(??{$block}))*\))/;
+
+# load the code into the interpreter
+sub load {
+ my $self = shift;
+ my $code = $self->{API}{code};
+ my $pkg = $self->{API}{pkg} || 'main';
+ my $env = Language::MzScheme::scheme_basic_env();
+
+ foreach my $chunk (split($block, $code)) {
+ $chunk =~ /\S/ or next;
+ my $result = eval {
+ Language::MzScheme::scheme_eval_string($chunk, $env);
+ };
+ croak "Inline::MzScheme: Problem evaluating code:\n$chunk\n\nReason: $@"
+ if $@;
+ croak "Inline::MzScheme: Problem evaluating code:\n$chunk\n"
+ unless $result; # == 1;
+ }
+
+ # look for possible global defines
+ while ($code =~ /\bdefine\s+\W*(\S+)/g) {
+ my $name = $1;
+
+ # try to lookup a procedure object
+ my $proc = eval {
+ Language::MzScheme::scheme_eval_string($name, $env)
+ } or next;
+
+ no strict 'refs';
+ *{"${pkg}::$name"} = sub {
+ my $list = join(
+ ' ',
+ map {
+ Scalar::Util::looks_like_number($_) ? $_ : do {
+ my $str = $_;
+ $str =~ s/(?:["\\])/\\/g;
+ qq("$str");
+ };
+ } @_
+ );
+
+ my $out = Language::MzScheme::scheme_make_string_output_port();
+ my $rv = Language::MzScheme::scheme_eval_string("($name $list)", $env);
+ Language::MzScheme::scheme_display($rv, $out);
+ return Language::MzScheme::scheme_get_string_output($out);
+ };
+ }
+
+}
+
+# no info implementation yet
+sub info { }
+
+1;
+
+__END__
+
+=head1 ACKNOWLEDGEMENTS
+
+Thanks to Sam Tregar's L<Inline::Guile> for showing me how to do this.
+
+=head1 SEE ALSO
+
+L<Language::MzScheme>, L<Inline>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2004 by Best Practical Solutions, LLC.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
Added: mzscheme/Inline-MzScheme/t/0-signature.t
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/t/0-signature.t Mon Jun 7 00:37:57 2004
@@ -0,0 +1,24 @@
+#!/usr/bin/perl
+
+use strict;
+print "1..1\n";
+
+if (!-s 'SIGNATURE') {
+ print "ok 1 # skip No signature file found\n";
+}
+elsif (!eval { require Module::Signature; 1 }) {
+ print "ok 1 # skip ",
+ "Next time around, consider installing Module::Signature, ",
+ "so you can verify the integrity of this distribution.\n";
+}
+elsif (!eval { require Socket; Socket::inet_aton('pgp.mit.edu') }) {
+ print "ok 1 # skip ",
+ "Cannot connect to the keyserver\n";
+}
+else {
+ (Module::Signature::verify() == Module::Signature::SIGNATURE_OK())
+ or print "not ";
+ print "ok 1 # Valid signature\n";
+}
+
+__END__
Added: mzscheme/Inline-MzScheme/t/1-basic.t
==============================================================================
--- (empty file)
+++ mzscheme/Inline-MzScheme/t/1-basic.t Mon Jun 7 00:37:57 2004
@@ -0,0 +1,29 @@
+#!/usr/bin/perl
+
+use strict;
+use Test;
+
+BEGIN { plan tests => 3 }
+
+use Inline MzScheme => q{
+
+(define (square x) (* x x))
+
+(define plus_two
+ (lambda (num)
+ (+ num 2)))
+
+(define cat_two
+ (lambda (str)
+ (string-append str "two")))
+
+};
+
+my $three = plus_two(1);
+ok($three, 3);
+
+my $one_two = cat_two("one");
+ok($one_two, "onetwo");
+
+my $squared = square(1.61828);
+ok(substr($squared, 0, 5), 2.618);
Modified: mzscheme/Language-MzScheme/lib/Language/MzScheme.pm
==============================================================================
--- mzscheme/Language-MzScheme/lib/Language/MzScheme.pm (original)
+++ mzscheme/Language-MzScheme/lib/Language/MzScheme.pm Mon Jun 7 00:37:57 2004
@@ -40,7 +40,7 @@
=head1 SEE ALSO
-L<http://plt-scheme.org/software/mzscheme/>
+L<Inline::MzScheme>, L<http://plt-scheme.org/software/mzscheme/>
=head1 AUTHORS
@@ -48,7 +48,7 @@
=head1 COPYRIGHT
-Copyright 2004 by Best Practical Solutions, LLC.
+Copyright 2004 by Autrijus Tang E<lt>autrijus at autrijus.orgE<gt>.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
More information about the Rt-commit
mailing list