# -*- perl -*-
#
# $Id: WrapLoader.pm,v 1.1 1999/01/11 20:38:49 ejb Exp $
# $Source: /home/ejb/scripts/RCS/WrapLoader.pm,v $
# $Author: ejb $
#
# This file accompanies wrapperl and is used to trivially encode
# modules.  Modules encoded with wrapperl (into pmx files) can be
# loaded by calling WrapLoad::load with the module names as in
#
# require WrapLoader;
# WrapLoader::load(qw(Module1 Dir::Module2));
#

require 5.002;
use strict;

package WrapLoader;

use Carp;

sub load
{
    my $class = __PACKAGE__;
    my %pending = ();
    my @modules = @_;
    for (@modules)
    {
	$pending{$_} = 1;
    }
    my @to_load = ();
    my $inc;
    foreach $inc (@INC)
    {
	my $mod;
	foreach $mod (@modules)
	{
	    next unless $pending{$mod};
	    my $base = "$inc/$mod";
	    $base =~ s,::,/,g;
	    my $pm = $base . ".pm";
	    my $pmx = $base . ".pmx";
	    my $to_load = undef;
	    # Use pmx if both pm and pmx exist.
	    if (-f $pmx)
	    {
		$to_load = $pmx;
	    }
	    elsif (-f $pm)
	    {
		$to_load = $pm;
	    }
	    if (defined $to_load)
	    {
		delete $pending{$mod};
		push(@to_load, [$to_load, $mod]);
	    }
	}
    }
    my $error = 0;
    for (@modules)
    {
	if (exists $pending{$_})
	{
	    carp "Can't find module $_";
	    $error = 1;
	}
    }
    croak "$class: Some modules were not found" if $error;
    for (@to_load)
    {
	my ($path, $mod) = @$_;
	if ($path =~ m/pmx$/)
	{
	    my $tmpdir = "/tmp/.#Loader.$$";
	    my $modfile = $mod;
	    $modfile =~ s,::,/,g;
	    my $newfile = "$tmpdir/$modfile";
	    my $newdir = ($newfile =~ m,(.*)/[^/]+$,) ? $1 : ".";
	    &mkdir_p($newdir, 0700);
	    &decode_pmx($path, $newfile);
	    require $newfile;
	    &rmrf($tmpdir);
	}
	else
	{
	    require $path;
	}
    }
}

sub mkdir_p
{
    my $dir = shift;
    my $mode = shift;
    my $cur_path = (($dir =~ s,^/,,) ? "/" : "");
    my @components = split('/', $dir);
    while (@components)
    {
	$cur_path .= shift(@components);
	mkdir $cur_path, $mode;
	$cur_path .= "/";
    }
}

sub rmdir_p
{
    my $dir = shift;
    my $mode = shift;
    my $cur_path = (($dir =~ s,^/,,) ? "/" : "");
    my @components = split('/', $dir);
    while (@components)
    {
	$cur_path .= shift(@components);
	mkdir $cur_path, $mode;
	$cur_path .= "/";
    }
}

sub rmrf
{
    my $file = shift;
    system("rm -rf $file");
}

sub decode_pmx
{
    my ($path, $newfile) = @_;
    local(*NEW);
    local(*OLD);
    local($/);
    open(OLD, "<$path") or croak __PACKAGE__, ": can't read $path: $!";
    undef $/;
    my $buf = scalar(<OLD>);
    close(OLD);
    $buf =~ s/./chr(ord($&) ^ 31)/eg;
    open(NEW, ">$newfile") or croak __PACKAGE__, ": can't open $newfile: $!";
    print NEW $buf;
    close(NEW);
}

1;

#
# END OF WrapLoader
#