view release on metacpan or  search on metacpan

lib/C/TinyCompiler.pm  view on Meta::CPAN

			# All this mumbo jumbo is used to ensure that we get proper line
			# number reporting if the package cannot be use'd.
			eval '#line ' . (__LINE__-1) . ' "' . __FILE__ . "\"\nuse $package_spec";
			croak($@) if $@;
		}
		
		# Make sure we don't have any conflicting packages:
		if ($package_spec->conflicts_with($self, keys %{$self->{applied_package}})
			or grep {$_->conflicts_with($self, $package_spec)} keys %{$self->{applied_package}}
		) {
			# If there's a conflict, then mark the package as blocked
			$self->block_package($package_spec);
		}
		else {
			# Apply the package, storing the options (for use later under the
			# symbol application).
			$package_spec->apply($self, @options);
			$self->{applied_package}->{$package_spec} = [@options];
		}
	}
}

=head1 MANAGING PACKAGES

Certain packages require other packages, and some packages do not play nicely
together. The current package management system is not very sophisticated, but
it does provide a means for packages to indicate dependencies and conflicts with
others. In general, all of this should be handled by the packages and manual
intervention from a user should usually not be required.

As far as the compiler is concerned, a package can be in one of three
states: (1) applied, (2) blocked, or (3) unknown. An applied package is any
package that you have applied directly or which has been pulled in as a package
dependency (but which has not been blocked). A blocked package is one that
should should not be applied. An unknown package is one that simply has not
been applied or blocked.

As an illustration of this idea, consider the L<C::TinyCompiler::Perl> package and the
light-weight sub-packages like L<C::TinyCompiler::Perl::Croak>. The light-weight packages
provide a exact subset of L<C::TinyCompiler::Perl>, so if L<C::TinyCompiler::Perl> is loaded, the
sub-packages need to ensure that they do not apply themselves or, if they have
already been applied, that they remove themselves. This check and manipulation
occurs during the sub-packages' call to C<conflicts_with>

=head2 is_package_applied, is_package_blocked, is_package_known

Three simple methods to inquire about the status of a package. These return
boolean values indicating whether the package (1) is currently being applied, 
(2) is currently blocked, or (3) is either being applied or blocked.

=cut

sub is_package_applied {
	my ($self, $package) = @_;
	return exists $self->{applied_package}->{$package};
}

sub is_package_blocked {
	my ($self, $package) = @_;
	return exists $self->{blocked_package}->{$package};
}

sub is_package_known {
	my ($self, $package) = @_;
	return ($self->is_package_applied($package)
		or $self->is_package_blocked($package));
}

=head2 block_package

Blocks the given package and removes its args from the applied package list if
it was previously applied.

=cut

sub block_package {
	my ($self, $package) = @_;
	delete $self->{applied_package}->{$package};
	$self->{blocked_package}->{$package} = 1;
}

=head2 get_package_args

Returns the array ref containing the package arguments that were supplied when
the package was applied (or an empty array ref if the package was never applied
or has subsequently been blocked). This is the actual array reference, so any
manipulations to this array reference will effect the reference returned in
future calls to C<get_package_args>.

=cut

sub get_package_args {
	my ($self, $package) = shift;
	return $self->{applied_package}->{$package} || [];
}

lib/C/TinyCompiler/Perl/Croak.pm  view on Meta::CPAN

}

sub conflicts_with {
	my ($package, $state, @packages) = @_;
	
	# If Perl is not among the listed packages, we have no conflicts
	return 0 unless grep { $_ eq 'C::TinyCompiler::Perl' } @packages;
	
	# If we're here, we know that Perl *is* among the @packages, so we have a
	# conflict. If this package has not been applied, then we can simply return
	# a true value, thus registering it as blocked.
	return 1 unless $state->is_package_applied($package);
	
	# We can only reach this line of code if this package *has* been applied and
	# we're about to apply C::TinyCompiler::Perl. As such, remove our code from the header
	# and block our own package.
	$state->code('Head') =~ s{/\* BEGIN $package .*"whatever comes after $package"}{}s;
	$state->block_package($package);
	
	# Don't register a conflict with C::TinyCompiler::Perl; it has been resolved on our end :-)
	return 0;