view release on metacpan or  search on metacpan

xs/PAB3/PAB3.pm  view on Meta::CPAN

# Module: PAB3
# Use "perldoc PAB3" for documentation 
# =============================================================================
use Carp ();
use Symbol ();

use strict;
no strict 'refs';
use warnings;
no warnings 'uninitialized';

use vars qw($VERSION %SC $_CURRENT);

use constant {
	SCALAR			=> 1,
	ARRAY			=> 2,
	HASH			=> 3,
	FUNC			=> 4,
};

BEGIN {
	$VERSION = '3.201';
	require XSLoader;
	XSLoader::load( __PACKAGE__, $VERSION );
	if( ! $PAB3::CGI::VERSION ) {
		$SIG{'__DIE__'} = \&_die_handler;
		$SIG{'__WARN__'} = \&_warn_handler;
	}
	*print_r = \&print_var;
}

END {
	&_cleanup();
}

1;

sub import {
	my $pkg = shift;
	my $callpkg = caller();
	if( $_[0] and $pkg eq __PACKAGE__ and $_[0] eq 'import' ) {
		*{$callpkg . '::import'} = \&import;
		return;
	}
	foreach( @_ ) {
		if( $_ eq ':const' || $_ eq ':default' ) {
			*{$callpkg . '::PAB_SCALAR'} = \&{$pkg . '::SCALAR'};
			*{$callpkg . '::PAB_ARRAY'} = \&{$pkg . '::ARRAY'};
			*{$callpkg . '::PAB_HASH'} = \&{$pkg . '::HASH'};
			*{$callpkg . '::PAB_FUNC'} = \&{$pkg . '::FUNC'};
		}
		if( $_ eq ':default' ) {
			*{$callpkg . '::print_var'} = \&{$pkg . '::print_var'};
			*{$callpkg . '::print_r'} = \&{$pkg . '::print_var'};
			*{$callpkg . '::require'} = \&{$pkg . '::require'};
			*{$callpkg . '::require_and_run'} = \&{$pkg . '::require_and_run'};
		}
	}
}

sub setenv {
	if( $0 =~ /^(.+\/)(.+?)$/ ) {
		$ENV{'SCRIPT_PATH'} = $1;
		$ENV{'SCRIPT'} = $2;
	}
	else {
		$ENV{'SCRIPT_PATH'} = '';
		$ENV{'SCRIPT'} = $0;
	}
}

sub new {
	my $proto = shift;
	my $class = ref( $proto ) || $proto;
	my $this = &_new( $class, @_ ) or return undef;
	my %arg = @_;
	$this->{'die'} = defined $arg{'die'} ? $arg{'die'} : 1;
	$this->{'warn'} = defined $arg{'warn'} ? $arg{'warn'} : 1;
	$this->{'path_template'} = $arg{'path_template'};
	$this->{'path_cache'} = $arg{'path_cache'};
	$this->{'auto_cache'} = $arg{'auto_cache'};
	$this->{'hashmap_cache'} = $arg{'hashmap_cache'};
	$this->{'logger'} = $arg{'logger'};
	return $this;
}

sub handle_error {
	my( $this ) = @_;
	if( $this ) {
		&Carp::croak( &error( $this ) ) if $this->{'die'};
		&Carp::carp( &error( $this ) ) if $this->{'warn'};
	}
	return 0;
}

sub parse_template {
	&_parse_template( @_ ) or return handle_error( @_ );
}

sub make_script_and_run {
	my( $this, $template, $cache, $package ) = @_;
	my( @ts, @cs, $rv, $ct, $cac, $tpl, $fh );
	$_CURRENT = $this;
	$package ||= ( CORE::caller )[0];
	$tpl = $this->{'path_template'} . $template;
	if( ! $cache && $this->{'auto_cache'} ) {
		$cache = '_auto.' . $template . '.pl';
		$cache =~ tr!/!.!;
		$cache =~ tr!\\!.!;
	}
	if( $cache ) {
		$cac = $this->{'path_cache'} . $cache;
		if( -f $tpl ) {
			@ts = stat( $tpl );
			if( -f $cac ) {
				@cs = stat( $cac );
				if( $ts[9] == $cs[9] ) {
					&require_and_run( $this, $cac, $package );
					return 1;
				}
			}

xs/PAB3/PAB3.pm  view on Meta::CPAN

PAB3 - Perl Application Builder / Version 3

=head1 SYNOPSIS

  use PAB3;

=head1 DESCRIPTION

C<PAB3> provides a framework for building rapid applications with Perl.
It includes a template handler for producing output. This part
is defined here.

=head2 Examples

Following example loads a template from B<template1.tpx>, does a loop
over the %ENV variable and prints the output to STDOUT.

- perl script -

  #!/usr/bin/perl -w
  
  use PAB3;
  
  my $pab = PAB3->new();
  
  $pab->make_script_and_run( 'template1.tpx' );

- B<template1.tpx> -

  main script:
  
  <*= $0 *>
  
  show the environment:
  
  <* LOOP HASH %ENV *>
  <* PRINT "[$_] => " . $ENV{$_} . "\n" *>
  <* END LOOP *>
  
  # or - with loop directive
  
  <* loop foreach( keys %ENV ) *>
  <* = "[$_] => " . $ENV{$_} . "\n" *>
  <* end loop *>
  
  # or - perl like
  
  <* foreach( keys %ENV ) { *>
  <* print "[$_] => " . $ENV{$_} . "\n" *>
  <* } *>
  
  # or - with internal function
  
  <* &PAB3::print_r( \%ENV ) *>


=head1 METHODS

=over

=item setenv ()

Set some useful variables to the interpreters environment 

these variables are:

  $ENV{'SCRIPT_PATH'}   : path to the main script
  $ENV{'SCRIPT'}        : name of the main script


=item new ( [%arg] )

Create a new instance of the PAB3 (template handler) class.

Posible arguments are:

  path_cache     => path to save parsed templates
  path_template  => path to the template files
  auto_cache     => create cache files automatically. 'path_cache' is required
  prg_start      => begin of program sequence, default is '<*'
  prg_end        => end of program sequence, default is '*>'
  cmd_sep        => command separator, to define more directives in one program
                    sequence, default is ';;'
  record_name    => name of default record in loops, default is '$_'
  logger         => reference to a PAB3::Logger class
  warn           => warn on error, default is OFF
  die            => die on error, default is ON
  class_name     => name of the variable for this class. eg '$pab'
                    It is needed when templates including templates. If its
                    undefined, a variable $PAB3::_CURRENT will
                    be used as a reference to the current PAB3 class.

Example:

  $pab = PAB3->new(
      'path_cache'    => '/path/to/cache',
      'path_template' => '/path/to/template-files',
  );


=item parse_template ( $template )

Parse the template given at I<$template> and return Perl code.
If I<$template> points to an existing file, the content of the file will be
parsed. In the other case the content of the variable will be used as template.

Example:

  $code = $pab->parse_template( '<*= $0 *>' );
  eval( $code );


=item make_script_and_run ( $template )

=item make_script_and_run ( $template, $cache )

=item make_script_and_run ( $template, $cache, $package )

Parse the template given at I<$template>, generate Perl code and execute it.
If I<$cache> is set to a filename or "auto_cache" is enabled, the Perl code
will be saved into a file. If the cache file already exists and the template has