#!perl -wuse strict;package Mac::StandaloneBuilder;use Mac::ResFork;use File::Copy;# CVS Id keywordmy $ID = q{ $Id: StandaloneBuilder.pm,v 1.7 2001/12/09 17:52:48 rose Exp $ };my $DEBUG = 0;my $GLUESFROM = $ENV{MACPERL}."site_perl:Mac:Glue:glues";my $GLUESTO = "lib:glues";my $LIBSTO = "lib:shared libs";# not testedmy $use_jcode = 1;eval "use Jcode;";$use_jcode = 0 if ($@ || $^X eq 'MacJPerl');# encapsulate{	my %_attributes = (		file => 1,		srcdir => 1,		srcfile => 1,		modules => 1,		libs => 1,		outputdir => 1,		outputfile => 1,		extra_modules => 1,		resfork => 0,	);		sub _attributes { keys %_attributes }		# start to be included modules with TEXT resource id 5000	my $_res_cnt = 5000;		sub _incr_res_cnt { $_res_cnt++ };}sub new {	my $class = shift;	my $self = bless {}, $class;	my %args = @_;	$DEBUG = $args{ DEBUG };		foreach my $member ( $self->_attributes ) {		if( $args{ $member } ) {			$self->{ $member } = $args{ $member }		}	}	unless( $self->{outputdir} ) {		my $srcfile = $self->{srcfile};		$srcfile =~ s/\.pl$//;		$srcfile =~ s/\.pm$//;		if( length( $srcfile ) > 31 ) {			$srcfile =~ substr( $srcfile, 0, 29 );		}		$self->{outputdir} = $self->{srcdir} . ":" . $srcfile . " Ä";		$self->{outputfile} = $srcfile;	}	$self->_doit;}sub _doit {	my $self = shift;	# step 1 - create output directory	#	unless( -e $self->{outputdir} ) {		print "DEBUG: mkdir( '$self->{outputdir}' )\n" if $DEBUG;		mkdir( $self->{outputdir}, 0755) or die $!;	}	chdir $self->{outputdir}Êor die $!;	# step 2 - make a MacPerl runtime	#	$self->_save_as_runtime;	# step 3 - adjust @INC for standalone in source code	#	$self->_process_source;	# step 4 - fill TEXT resources with needed modules	#	$self->_process_modules;	# step 5 - copy XS libraries to lib:shared libs: folder	#	$self->_copy_libs;	# step 6 - copy glue files if Mac::Glue is used	#	$self->_copy_glues;}sub _process_source {	local $^W = 0;	my $self = shift;	my $resfork = $self->{resfork};		my $changes = <<eos;BEGIN {	chop( my( \$CWD ) = `pwd` );	\$CWD =~ s/:\$//;    unshift( \@INC, \$CWD.":$LIBSTO" );	\$ENV{ MACGLUEDIR } = \$CWD.":$GLUESTO";}eos	my $source = $resfork->Get_One_Res_By_Index( 'TEXT', 0 ) or die "couldn't get source from ResFork";	$resfork->Delete_One_Res_By_Index('TEXT', 0);	if ($source =~ /^#\!.*perl/) { $source =~ s/^(#\!.*perl.*)/$1\n$changes\n/ }	else { $source = $changes . $source }		$resfork->Add_One_Res( 'TEXT', '128', '!', $source );}sub _process_modules {	my $self = shift;	my $resfork = $self->{resfork};	local *L;	local $/ = undef;		for my $module ( sort @{ $self->{modules} } ) {		# source script is already TEXT, 128 resource		next if $module eq $self->{file};		my $resid = $self->_incr_res_cnt;		open L, $module or die "ERROR: opening '$module'\n$!";		my @text = <L>;		close L;		my $name = $module;		$name =~ s/\Q$self->{srcdir}\E//o;		$name =~ s/\Q$ENV{MACPERL}\E//o;		$name =~ s/^://;		$name =~ s/^lib://;		$name =~ s/^site_perl://;		### $name =~ s/:/\//g;		print "adding: $resid - $name", $DEBUG ? " ('$module')\n" : "\n";		$resfork->Add_One_Res( 'TEXT', $resid, $name, @text );	}	if( ref $self->{extra_modules} eq 'ARRAY' ) {		print "adding extra modules ...\n";		for my $module ( sort @{ $self->{extra_modules} } ) {			my $resid = $self->_incr_res_cnt;			open L, $module or die "ERROR: opening '$module'\n$!";			my @text = <L>;			close L;			my $name = $module;			$name =~ s/$self->{srcdir}//o;			$name =~ s/$ENV{MACPERL}//o;			$name =~ s/^://;			$name =~ s/^lib://;			$name =~ s/^site_perl://;			### $name =~ s/:/\//g;			print "adding: $resid - $name", $DEBUG ? " ('$module')\n" : "\n";			$resfork->Add_One_Res( 'TEXT', $resid, $name, @text );		}	}}sub _save_as_runtime {	my $self = shift;	print "creating MacPerl Runtime '$self->{outputdir}:$self->{outputfile}'\n";	my $script = <<eos;tell application "$^X"	ignoring application responses	save file Â	"$self->{file}"	in file "$self->{outputdir}:$self->{outputfile}" as Runtime	end ignoringend telleos	if( ! defined( MacPerl::DoAppleScript( $script ) ) ) {		die "AppleScript error during execution of:\n$script\n";	}		# auxilliary - make ResFork accessible	#	my $output = $self->{outputdir} . ":" . $self->{outputfile};	$self->{resfork} = Mac::ResFork->new( $output ) or die $!;}sub _copy_libs {	my $self = shift;	my $outputdir = $self->{outputdir};	my $libs_outputdir1 = $outputdir . ":lib";	my $libs_outputdir2 = $outputdir . ":$LIBSTO";		if( scalar @{ $self->{libs} } ) {		unless( -e $libs_outputdir1 ) {			mkdir( $libs_outputdir1, 0755) or die $!;		}		unless( -e $libs_outputdir2 ) {			mkdir( $libs_outputdir2, 0755) or die $!;		}	}	# shortcut if there are not libaries to include	else { return }	for my $module ( @{ $self->{libs} } ) {		print "copying library: $module\n";		copy $module, $libs_outputdir2 or die "copy $module, $libs_outputdir2 failed\n$!";	}}sub _copy_glues {	my $self = shift;	my $use_glues = 0;	my $outputdir = $self->{outputdir};	my $libs_outputdir1 = $outputdir . ":lib";	my $libs_outputdir2 = $outputdir . ":$GLUESTO";	for my $module ( @{ $self->{modules} } ) {		if( $module =~ /Mac:Glue.pm$/ ) {			$use_glues = 1;			last;		}	}	if( $use_glues ) {		unless( -e $libs_outputdir1 ) {			mkdir( $libs_outputdir1, 0755) or die $!;		}		unless( -e $libs_outputdir2 ) {			mkdir( $libs_outputdir2, 0755) or die $!;		}	}	# shortcut if there are not glues to include	else { return }	print "copying glues...\n";	## _copy_dirtree( $GLUESFROM, $libs_outputdir2 );	# create subdirs for glues ("dialects", "additions") if found in MacPerl installation	# FIXME: this will break if another level of subdirs would exist	#	use File::Find;	my @glue_subdirs;	find( sub { push @glue_subdirs, $File::Find::name if -d $_ }, $GLUESFROM );	for my $subdir ( @glue_subdirs  ) {		next if $subdir eq $GLUESFROM;		$subdir =~ s/$GLUESFROM:(.+)/$outputdir:$GLUESTO:$1/o;		unless( -d $subdir ) { mkdir( $subdir, 0755 ) or die "creating subdir '$subdir'\n$!" }	}	# copy all files from site_perl:Mac:Glue:glues	my @glue_files;	find( sub { push @glue_files, $File::Find::name unless( -d $_ || /Icon/ ) }, $GLUESFROM );	for my $file ( @glue_files ) {		# data sample		# 'Festplatte:Projekte:MacPerl5.6.1b2:site_perl:Mac:Glue:glues:Cumulus_S5_0.pod'		# 'Festplatte:Projekte:MacPerl5.6.1b2:site_perl:Mac:Glue:glues:dialects:AppleScript.pod'		# 'Festplatte:Projekte:MacPerl5.6.1b2:site_perl:Mac:Glue:glues:additions:DePlus_OSAX'		( my $tofile = $file ) =~ s/$GLUESFROM:(.+)/$outputdir:$GLUESTO:$1/o;		print "DEBUG: copying $file to \n$tofile ...\n" if $DEBUG;		copy $file, $tofile or die "copy '$file', '$tofile' failed with $!";	}}sub _copy_dirtree {	my( $fromdir, $todir ) = @_;	die unless -d $fromdir;	die unless -d $todir;	use File::Find;	my @found;	find( sub { push @found, $File::Find::name unless( -d $_ || /Icon/ ) }, $fromdir );	## print join "\n", @found, "\n";	for my $file ( @found ) {		$file =~ m/$fromdir:(.+)/o and my $relpath = $1 or die "regex failed on '$file'";		if( $relpath =~ /:/ ) {			print "relpath = $relpath\n";		}	}}1;__END__