File Coverage

blib/lib/POE/Devel/ProcAlike.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

# Declare our package
package POE::Devel::ProcAlike;
use strict; use warnings;

# Initialize our version
use vars qw( $VERSION );
$VERSION = '0.02';

# Import what we need from the POE namespace
use POE;
use POE::Component::Fuse;
use base 'POE::Session::AttributeBased';

# load our modules to manage the filesystem
use Filesys::Virtual::Async::Dispatcher;
use Filesys::Virtual::Async::inMemory;
use POE::Devel::ProcAlike::POEInfo;
use POE::Devel::ProcAlike::PerlInfo;
use POE::Devel::ProcAlike::ModuleInfo;

# portability...
use File::Spec;

# Set some constants
BEGIN {
	if ( ! defined &DEBUG ) { *DEBUG = sub () { 0 } }
}

# starts the component!
sub spawn {
	my $class = shift;

	# are we already created?
	if ( $poe_kernel->alias_resolve( 'poe-devel-procalike' ) ) {
		if ( DEBUG ) {
			warn "Calling " . __PACKAGE__ . "->spawn() multiple times will only result in a singleton!";
		}
		return 1;
	}

	# The options hash
	my %opt;

	# Support passing in a hash ref or a regular hash
	if ( ( @_ & 1 ) and ref $_[0] and ref( $_[0] ) eq 'HASH' ) {
		%opt = %{ $_[0] };
	} else {
		# Sanity checking
		if ( @_ & 1 ) {
			warn __PACKAGE__ . ' requires an even number of options passed to spawn()';
			return 0;
		}

		%opt = @_;
	}

	# lowercase keys
	%opt = map { lc($_) => $opt{$_} } keys %opt;

	# setup the FUSE mount options
	if ( ! exists $opt{'fuseopts'} or ! defined $opt{'fuseopts'} ) {
		if ( DEBUG ) {
			warn 'Using default FUSEOPTS = undef';
		}

		# Set the default
		$opt{'fuseopts'} = undef;
	} else {
		# TODO validate for sanity
	}

	# setup the user-supplied "misc" fsv object
	if ( ! exists $opt{'vfilesys'} or ! defined $opt{'vfilesys'} ) {
		if ( DEBUG ) {
			warn 'Using default VFILESYS = undef';
		}

		# Set the default
		$opt{'vfilesys'} = undef;
	} else {
		# make sure it's a real object
		if ( ! ref $opt{'vfilesys'} ) {
			warn 'The passed-in vfilesys option is not an object';
			return 0;
		} else {
			if ( ! $opt{'vfilesys'}->isa( 'Filesys::Virtual::Async' ) ) {
				warn 'The passed-in vfilesys object is not a subclass of Filesys::Virtual::Async';
				return 0;
			}
		}
	}

	# Create our session
	POE::Session->create(
		__PACKAGE__->inline_states(),
		'heap'	=>	{
			'ALIAS'		=> 'poe-devel-procalike',
			'FUSEOPTS'	=> $opt{'fuseopts'},

			# our filesystem objects
			'DISPATCHER'	=> undef,
			'ROOTFS'	=> undef,
			'PERLFS'	=> POE::Devel::ProcAlike::PerlInfo->new(),
			'POEFS'		=> POE::Devel::ProcAlike::POEInfo->new(),
			'MODULEFS'	=> POE::Devel::ProcAlike::ModuleInfo->new(),
			'MISCFS'	=> $opt{'vfilesys'},
		},
	);

	# return success
	return 1;
}

# This starts the component
sub _start : State {
	if ( DEBUG ) {
		warn 'Starting alias "' . $_[HEAP]->{'ALIAS'} . '"';
	}

	# Set up the alias for ourself
	$_[KERNEL]->alias_set( $_[HEAP]->{'ALIAS'} );

	# create the root filesystem for use in the Dispatcher
	my $filesystem = {
		File::Spec->rootdir()	=> {
			'mode'	=> => oct( '040755' ),
			'ctime'	=> time(),
		},
		File::Spec->catdir( File::Spec->rootdir(), 'perl' ) => {
			'mode'	=> => oct( '040755' ),
			'ctime'	=> time(),
		},
		File::Spec->catdir( File::Spec->rootdir(), 'kernel' ) => {
			'mode'	=> => oct( '040755' ),
			'ctime'	=> time(),
		},
		File::Spec->catdir( File::Spec->rootdir(), 'modules' ) => {
			'mode'	=> => oct( '040755' ),
			'ctime'	=> time(),
		},
		File::Spec->catdir( File::Spec->rootdir(), 'misc' ) => {
			'mode'	=> => oct( '040755' ),
			'ctime'	=> time(),
		},
	};
	$_[HEAP]->{'ROOTFS'} = Filesys::Virtual::Async::inMemory->new(
		'filesystem'	=> $filesystem,
		'readonly'	=> 1,
	);

	# finally, tie them all together in the dispatcher!
	$_[HEAP]->{'DISPATCHER'} = Filesys::Virtual::Async::Dispatcher->new(
		'rootfs'	=> $_[HEAP]->{'ROOTFS'},
	);
	$_[HEAP]->{'DISPATCHER'}->mount( File::Spec->catdir( File::Spec->rootdir(), 'perl' ), $_[HEAP]->{'PERLFS'} );
	$_[HEAP]->{'DISPATCHER'}->mount( File::Spec->catdir( File::Spec->rootdir(), 'kernel' ), $_[HEAP]->{'POEFS'} );
	$_[HEAP]->{'DISPATCHER'}->mount( File::Spec->catdir( File::Spec->rootdir(), 'modules' ), $_[HEAP]->{'MODULEFS'} );
	if ( defined $_[HEAP]->{'MISCFS'} ) {
		$_[HEAP]->{'DISPATCHER'}->mount( File::Spec->catdir( File::Spec->rootdir(), 'misc' ), $_[HEAP]->{'MISCFS'} );
	}

	# spawn the fuse poco
	POE::Component::Fuse->spawn(
		'umount'	=> 1,
		'mkdir'		=> 1,
		'mount'		=> "/tmp/poefuse_$$",
		'rmdir'		=> 1,
		( defined $_[HEAP]->{'FUSEOPTS'} ? %{ $_[HEAP]->{'FUSEOPTS'} } : () ),

		# make sure the user cannot override those options
		'alias'		=> $_[HEAP]->{'ALIAS'} . '-fuse',
		'vfilesys'	=> $_[HEAP]->{'DISPATCHER'},
		'session'	=> $_[SESSION]->ID,
	);

	return;
}

# POE Handlers
sub _stop : State {
	if ( DEBUG ) {
		warn 'Stopping alias "' . $_[HEAP]->{'ALIAS'} . '"';
	}

	return;
}

sub shutdown : State {
	# cleanup some stuff
	$_[KERNEL]->alias_remove( $_[HEAP]->{'ALIAS'} );

	# tell poco-fuse to shutdown
	$_[KERNEL]->post( $_[HEAP]->{'ALIAS'} . '-fuse', 'shutdown' );

	return;
}

# handles poco-fuse shutting down
sub fuse_CLOSED : State {
	$_[KERNEL]->yield( 'shutdown' );

	return;
}

# adds a poco to the fs
sub register : State {
	my $fsv = $_[ARG0];

	# determine caller info
	my $module = ( caller(4) )[0];
	if ( $module eq 'POE::Kernel' ) {
		# we were not dispatched via call(), complain!
		warn "Registering a module must be done via call() not post()";
		return;
	}

	# Weed out modules that we know is unable to register
	if ( $module eq 'main' ) {
		warn "Unable to register from package 'main' because it is ambiguous, please do so from a proper package";
		return;
	}

	# is the fsv a valid object?
	if ( ! defined $fsv or ! ref $fsv or ! $fsv->isa( 'Filesys::Virtual::Async' ) ) {
		warn "The FsV object is not a valid subclass of Filesys::Virtual::Async";
		return;
	}

	# Try to register the module!
	my $result = $_[HEAP]->{'MODULEFS'}->register( $module );
	if ( defined $result ) {
		# successfully registered, add it to the dispatcher!
		$_[HEAP]->{'DISPATCHER'}->mount( File::Spec->catdir( File::Spec->rootdir(), 'modules', $result ), $fsv );
		return 1;
	} else {
		warn "The package '$module' is already registered";
		return;
	}
}

# removes a poco from the fs
sub unregister : State {
	# determine caller info
	my $module = ( caller(4) )[0];
	if ( $module eq 'POE::Kernel' ) {
		# we were not dispatched via call(), complain!
		warn "Unregistering a module must be done via call() not post()";
		return;
	}

	# Weed out modules that we know is unable to register
	if ( $module eq 'main' ) {
		warn "Unable to register from package 'main' because it is ambiguous, please do so from a proper package";
		return;
	}

	# Try to register the module!
	my $result = $_[HEAP]->{'MODULEFS'}->unregister( $module );
	if ( defined $result ) {
		# successfully unregistered, remove it from the dispatcher!
		$_[HEAP]->{'DISPATCHER'}->umount( File::Spec->catdir( File::Spec->rootdir(), 'modules', $result ) );
		return 1;
	} else {
		warn "The package '$module' was never registered";
		return;
	}
}

1;
__END__