view release on metacpan or  search on metacpan

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

package C::TinyCompiler::Perl::Croak;
use strict;
use warnings;
use parent 'C::TinyCompiler::package';

BEGIN {
	our $VERSION = '0.05';
	use XSLoader;
	XSLoader::load 'C::TinyCompiler::Perl::Croak', $VERSION;
}

sub apply {
	my (undef, $state) = @_;
	
	# Add function declarations and symbols:
	$state->code('Head') .= C::TinyCompiler::line_number(__LINE__) . q{
		/* BEGIN C::TinyCompiler::Perl::Croak */
		#include <stdarg.h>
		void croak(const char *pat, ...);
		void warn(const char *pat, ...);
		void vcroak(const char *pat, va_list *args);
		void vwarn(const char *pat, va_list *args);
		#line 1 "whatever comes after C::TinyCompiler::Perl::Croak"
	};
}

# Retrieve the symbol pointers only once:
my $symbols = get_symbol_ptrs();

sub apply_symbols {
	my (undef, $state) = @_;
	$state->add_symbols(%$symbols);
}

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;
}

1;

__END__

=head1 NAME

C::TinyCompiler::Perl::Croak - A light-weight interface to Perl's croak and warn

=head1 SYNOPSIS

 use C::TinyCompiler;
 
 # Declare the compiler context with the AV bindings:
 my $context= C::TinyCompiler->new(packages => '::Perl::Croak');
 
 # Create a rather antisocial function:
 $context->code('Body') = q{
     void dont_call(void) {
         croak("I told you not to call!");
     }
 };
 
 # Compile and call:
 $context->compile;
 eval {
     $context->call_function('dont_call');
     1
 } or do {
     print "Got error $@\n";
 };

=head1 DESCRIPTION

This module provides Perl's C interface to both the traditional and variadic
forms of warn and croak. These allow you to write defensive C code without
needing the full Perl C api to do it.

Like other C::TinyCompiler packages, you never use this module directly. Rather, you
add it to your compiler context in the constructor or with the function
L<C::TinyCompiler/apply_packages>.

You can find documentation for these functions at L<perlapi>. However, the
discussion of the variadic forms of is not terribly illuminating, so I provide
a few examples below.

=over

=item *