DynaPage::Document - DynaPage Document container

DynaPage-Document documentation Contained in the DynaPage-Document distribution.

Index

Code Index:

NAME

Top

DynaPage::Document - DynaPage Document container

 #------------------------------------------------------
 # (C) Daniel Peder & Infoset s.r.o., all rights reserved
 # http://www.infoset.com, Daniel.Peder@infoset.com
 #------------------------------------------------------

SYNOPSIS

Top

step1 - document ( create file mydoc.document )

  ---[content of mydoc-document.info]---

  !include.template =- mydoc-template.htmt
  my-title =- This is single line
  my-head =- Hello World
  my-para ==~
   This is block
   multiline content
   blah blah
   blah blah
  ~== my-para 

  ---[content of mydoc-document.info]---

step2 - template ( create file mydoc.template )

  ---[content of mydoc-template.htmt]---

  <html>
  <title>[~my-title~]</title>
  <h1>[~my-head~]</h1>
  <p>[~my-para~]</p>
  </html>

  ---[content of mydoc-template.htmt]---

step3 - open

  use DynaPage::Document;
  use DynaPage::Document::ext::include;
  my $doc = DynaPage::Document->new(
    {
      RootDir=>'.',
      Document=>'mydoc-document.info',
    }
  );

step4 - render

 print $doc->Render();

  ---[dump of printed result]---
  <html>
  <title>This is single line</title>
  <h1>Hello World</h1>
  <p>   This is block
   multiline content
   blah blah
   blah blah</p>
  </html>
  ---[dump of printed result]---

See also

Working copy of this SYNOPSIS :

 .../DynaPage/Document/EXAMPLES/SYNOPSIS

Other EXAMPLES :

 .../DynaPage/Document/EXAMPLES/

How to make it with Apache2/mod_perl2 :

 SYNOPSIS of DynaPage::Apache2

Powerfull extensions to increase website building productivity

 METHODS of DynaPage::Document::ext::include

DESCRIPTION

Top

 $Revision: 1.10 $
 $Date: 2005/01/14 12:23:49 $

METHODS

Top

new ( $options ) : blessed

example:

$options = {

	RootDir  => '/my/RootDir/'
	Document => '//my/RootDir/BaseDir/Document.info',
	Template => '//my/work/dir/include/Template.htmt',
	DocumentDir  => '/my/RootDir/BaseDir/'

	Data => $data_for_sourcer,

	HooksEnable => 1,
}

RootDir must be allways specified as absolute path.

Double slashed path for Document and Template forces absolute path within filesystem.

BaseDir is absolute path to directory where is the Document located.

Path specifications within the Document :

 - without leading slash - relative to BaseDir
 - with single leading slash - relative to RootDir
 - with double leading slash - absolute to filesystem

HooksEnable is by default set to true. Set it to FALSE to disable hooks.

Render ( ) : string

Render final document. Just shortcut of $self->Template->Feed() .

SetSignal ( $name, $message ) : $string

Set internal document signal to $message value.

Set $self->{SIGNAL_STATUS} to true, increasing it by 1.

GetSignal ( [$name [, $clear]] ) : bool | string

Without $name specified, return $self->{SIGNAL_STATUS}.

Get value of $message previously set signal $name.

With $clear set to any TRUE value, the message will be cleared.

Allways clear the $self->{SIGNAL_STATUS}.

Returns undef unless signal of given $name doesn't exists, this is the exception, when the $self->{SIGNAL_STATUS} is not cleared.

CallHook ( $name ) : $string

Call included document hook / if any.

Template ( $template_body ) : blessed Template

Get blessed Template object unless $template_body specified. Otherwise create new template object using template_body .

Sourcer ( ) : blessed Sourcer

Sourcer object.

Get ( @args ) : SOURCER

SOURCER: see DynaPage::Sourcer for details. This is only shortcut interface to SOURCER methods.

    $self->Sourcer->Get(@args)
Set ( @args ) : SOURCER

SOURCER: see DynaPage::Sourcer for details. This is only shortcut interface to SOURCER methods.

    $self->Sourcer->Set(@args)
Add ( @args ) : SOURCER

SOURCER: see DynaPage::Sourcer for details. This is only shortcut interface to SOURCER methods.

    $self->Sourcer->Add(@args)
HandleIncludes ( ) : bool

Handle recently parsed include references:

!include.data ... subdocument ... example: /myinc/subdoc.idoc

!include.template ... master template ... example: /mytmplt/templt1.htmt

!include.parameters ... PGCE - POST, GET, COOKIES, ENV values imported into names with prefixes P_, G_, C_, E_, or without prefixes if specified as lowercase pgce.

example: PGe ... will import POST and GET parameters with prefixes, ENV values without prefixes, COOKIES not imported.

Specifiyng 'A' or 'a' is shortcut for 'PGCE' resp. 'pgce'.

!include.module ... use Any::Perl::Module::You::Wish ... multiple modules could be specified, each one by new single line.

!include.handlers ... will be obsoleted by include.hooks (which is better description of its purpose)

!include.hooks ... perl script fragmets called by document parent (currently DynaDoc::Apache).

There are currently two hooks used by DynaPage::Apache :

 - Init            ... after Apache created DynaPage::Document object
 - DocumentFinal   ... before Apache sends the content out.

example (fragment of document containing hooks definition):

  !include.hooks ==~

    Init => sub {
        my( $self, $hook_name, $hashref_parameters ) = @_;
        $self->Set( my_token_name => 'Hello World');
        # my_token_name will be later inserted 
        # into Template token mark [~my_token_name~] 
        return 1;
    }

  ~== !include.hooks
HandleExtensions ( ) : bool

Handle extensions. Their corresponding handlers must be one of following three sub references: (only the first one found is called, lookup is in following order)

 1: DynaPage::Document::ext::B<part1>::B<Part2>::PLUG()
 2: DynaPage::Document::ext::B<part1>::B<Part2()>::PLUG
 3: DynaPage::Document::ext::B<part1>::PLUG()

EXAMPLE:

source:

 ...
 !include.data =- /mydir/myfile.data
 ...

call:

 DynaPage::Document::ext::include::data( 
    $Doc, [ '!include.data','/mydir/myfile.data' ] 
 )

arguments:

$Doc is current document object

['...','...'] is arrayref with field_name and field_value obtained during source parsing.

Read ( $filename ) : string

Read the whole file, relative to RootDir.

Serialize ( $filename, $fields ) : string | bool-success

Serialize document's fields.

GetAbsFilename ( $filename )

Get absolute filename. Filenames without leading slash are relative to DocumentDir directory, of the document itself. Single leading slash '/' is for RootDir and double leading slash '//' is for absolute path within filesystem.

RootDir ( [ $dir ] )

Explicitly set root dir name.

DocumentDir ( [ $dir ] )

Explicitly set document dir name.

TODO

Top

1. modules inclusion - a) inclusion, b) hook points

2. multiple templates support for different content types - html, wap, txt, ...

DynaPage-Document documentation Contained in the DynaPage-Document distribution. 
### //////////////////////////////////////////////////////////////////////////
#
#	TOP
#


###													###
###	size of <TAB> in this document is 4 characters	###
###													###

### //////////////////////////////////////////////////////////////////////////
#
#	SECTION: intro
#




### //////////////////////////////////////////////////////////////////////////
#
#	SECTION: package
#

    package DynaPage::Document;


### //////////////////////////////////////////////////////////////////////////
#
#	SECTION: version
#

	use vars qw( $VERSION $VERSION_LABEL $REVISION $REVISION_DATETIME $REVISION_LABEL $PROG_LABEL );

	$VERSION           = '0.90';
	
	$REVISION          = (qw$Revision: 1.10 $)[1];
	$REVISION_DATETIME = join(' ',(qw$Date: 2005/01/14 12:23:49 $)[1,2]);
	$REVISION_LABEL    = '$Id: Document.pm,v 1.10 2005/01/14 12:23:49 root Exp root $';
	$VERSION_LABEL     = "$VERSION (rev. $REVISION $REVISION_DATETIME)";
	$PROG_LABEL        = __PACKAGE__." - ver. $VERSION_LABEL";



### //////////////////////////////////////////////////////////////////////////
#
#	SECTION: debug
#

	# use vars qw( $DEBUG ); $DEBUG=0;
	

### //////////////////////////////////////////////////////////////////////////
#
#	SECTION: constants
#

	# use constant	name		=> 'value';
	

### //////////////////////////////////////////////////////////////////////////
#
#	SECTION: modules use
#

	require 5.005_62;

	use strict                  ;
	use warnings                ;
	
	use	DynaPage::Sourcer		;
	use	DynaPage::Template		;
	use	IO::File::String		;
	use	File::Spec				;
	

### //////////////////////////////////////////////////////////////////////////
#
#	SECTION: class properties
#

#	our	$config	= 
#	{
#	};
	

### //////////////////////////////////////////////////////////////////////////
#
#	SECTION: methods
#




### ##########################################################################


### --------------------------------------------------------------------------
sub		new
### --------------------------------------------------------------------------
{
	my( $proto, $options ) = @_;
	
	my	$self  = {};
		bless( $self, (ref( $proto ) || $proto ));
		
		# OPTIONS
		
		$options->{HooksEnable} = 1 unless exists $options->{HooksEnable};
		
		$self->{OPTIONS} = $options;
		
		$self->RootDir( $options->{RootDir} ) or die "RootDir option must be specified.";
	
		$self->{Sourcer}	= 
	my	$Sourcer			= DynaPage::Sourcer->new();

		# set Default values
		$Sourcer->Add( 'DynaPage.PROG_LABEL'=> $PROG_LABEL ) ;

		# set Document		
		if( $options->{DocumentDir} )
		{
			$self->DocumentDir( $options->{DocumentDir} )
		}
		if( my $Document = $options->{Document} )
		{
			my($volume,$directories,$file) = File::Spec->splitpath( $Document );
			unless( $self->DocumentDir() )
			{
				$self->DocumentDir( $directories );
			}
            $self->{DocumentFilename} = $file;
            $Sourcer->Set( 'D_DocumentFilename' => $file ); # TODO: move it into prefixers

			if( my $docdata = $self->Read( $Document ) ) {
				$Sourcer->Parse( $docdata );
	       		#$self->HandleIncludes();
	       		$self->HandleExtensions();
	       		$Sourcer->ClearStats();
			}

#			$Sourcer->Add( '!include.data'=> $options->{Document} ) ;
#			$self->HandleIncludes();
#			$Sourcer->ClearStats();
			
		}
		unless( $self->DocumentDir() )
		{
			$self->DocumentDir( $self->RootDir() );
		}

		# set Template
		if( $options->{Template} )
		{
			$Sourcer->Add( '!include.template'=> $options->{Template} );
       		#$self->HandleIncludes();
       		$self->HandleExtensions();
			$Sourcer->ClearStats();
		}

		# handle other 'Data' content
		$Sourcer->Parse( $options->{Data} ) if $options->{Data};
   		#$self->HandleIncludes();
   		$self->HandleExtensions();
		
		# call hook
		$self->CallHook( 'Init' );
	
	$self
}


### ##########################################################################


### --------------------------------------------------------------------------
sub		Render
### --------------------------------------------------------------------------
{
	my( $self ) = @_;
    
		$self->Template->Feed();
}


### ##########################################################################


### --------------------------------------------------------------------------
sub		SetSignal
### --------------------------------------------------------------------------
{
	my( $self, $name, $message ) = @_;
    $self->{SIGNAL}{$name} = $message;
    $self->{SIGNAL_STATUS}++;
}


### ##########################################################################


### --------------------------------------------------------------------------
sub		GetSignal
### --------------------------------------------------------------------------
{
	my( $self, $name, $clear ) = @_;
	
	if( $name && !exists( $self->{SIGNAL}{$name} )) {
        return undef
    }
	my $signal_status = delete $self->{SIGNAL_STATUS};
    return $signal_status unless $name;
    
	my $message = $self->{SIGNAL}{$name};
	delete $self->{SIGNAL}{$name} if( $clear );

	return $message
}


### ##########################################################################


### --------------------------------------------------------------------------
sub		CallHook
### --------------------------------------------------------------------------
{
	my(	$self, $hook_name, $call_params ) = @_;
	
	return 0 unless $self->{OPTIONS}{HooksEnable};
	
	return undef unless
	my	$hook = $self->{HOOK}{$hook_name};

	my	$result	= eval
		{	
			&$hook( $self, $hook_name, $call_params )
		};
		if( $@ )
		{
			warn "ERR[CallHook.$hook_name]: $@";
			$self->{HOOK_ERR}++;
			$self->{HOOK_ERRMSG}{$hook_name} = $@;
			return undef, $@;
		}
	
	return $result
}

### ##########################################################################


### --------------------------------------------------------------------------
sub		Template
### --------------------------------------------------------------------------
{
	my( $self, $template_body ) = @_;

	unless( $template_body or $self->{TEMPLATE} )
	{
		# create automatic template dumping all values
		$template_body = "Automatic Template Content Dump";
		for my $name ( $self->Sourcer->Names )
		{
			next if $name =~ /^!/;
			$template_body .= qq{\n\n---\n$name:\n[~$name~]\n};
		}
		$self->Sourcer->Add( '!content-type' => 'text/plain' );
	}

    if( $template_body )
    {
		$self->{TEMPLATE} = DynaPage::Template->new( $template_body, $self->Sourcer );
	}

	$self->{TEMPLATE}
}


### ##########################################################################


### --------------------------------------------------------------------------
sub		Sourcer
### --------------------------------------------------------------------------
{
	my( $self ) = @_;
	
	$self->{Sourcer}    
}


### ##########################################################################


### --------------------------------------------------------------------------
sub		Get
### --------------------------------------------------------------------------
{
	my( $self, @args ) = @_;
	return $self->Sourcer->Get(@args);
    
}

### ##########################################################################


### --------------------------------------------------------------------------
sub		Set
### --------------------------------------------------------------------------
{
	my( $self, @args ) = @_;
	return $self->Sourcer->Set(@args);
    
}

### ##########################################################################


### --------------------------------------------------------------------------
sub		Add
### --------------------------------------------------------------------------
{
	my( $self, @args ) = @_;
	return $self->Sourcer->Add(@args);
    
}

### ##########################################################################


### --------------------------------------------------------------------------
sub		HandleIncludes
### --------------------------------------------------------------------------
{
	my( $self ) = @_;
	
	while( my @newValues = $self->Sourcer->NewValues() )
	{
		my	@jobs;

		for my $command ( grep {/^!include\./} @newValues )
		{
			next unless $command =~ /^!include\.(data|template|parameters|module|hooks|handlers|field)(?:\.([\w\-\.]+))?$/;
			my	$type	= $1;
			my  $type_ext = $2;
			my	$count	= $self->Sourcer->NewValues( $command );
			for my $i ( -$count..-1 )
			{
				my	$param	= $self->Sourcer->Get( $command, $i );
				push @jobs, [ $type, $type_ext, $param ];
			}
		}

		$self->Sourcer->ClearStats();

		for my $job ( @jobs )
		{
			my( $type, $type_ext, $param ) = @$job;

			if(		$type eq 'template' )
			{
				my	$data	= $self->Read( $param );
					$self->Template( $data ) if $data;
			}
			elsif(	$type eq 'data' )
			{
				my	$data	= $self->Read( $param );
					$self->Sourcer->Parse( $data ) if $data;
			}
			elsif(	$type eq 'field' )
			{
				my	$data	= $self->Read( $param );
				if( $data ) {
    				my  $field  = $type_ext;
    				unless( $field ) {
                        $field = $param;
                        $field =~ s{.*/([^/]+)$}{$1}s; # drop dir prefix
                        $field =~ s{[^\w\-\.]+}{_}gos; # convert invalid chars
                    }
    				$self->Sourcer->Set( $field => $data );
				}
			}
			elsif(	
                ($type eq 'hooks' or $type eq 'handlers') 
                and $self->{OPTIONS}{HooksEnable} 
            )
			{
				my $hooks = eval( '{' .$param . '}' );
				if( $hooks && ref($hooks) eq 'HASH' )
				{
					for my $key ( keys %$hooks )
					{
						my $hook = $hooks->{$key};
						unless( ref($hook) eq 'CODE' )
						{
							warn "ERR[include.$type]: '$key' isn't CODE reference";
						}
						
						$self->{HOOK}{$key} = $hook;
					}
				}
				elsif( $@ )
				{
					warn "ERR[include.$type]: $@";
				}
				else
				{
					warn "ERR[include.$type]: missing correct hook definitions";
				}
			}
			elsif(	$type eq 'module' )
			{
				my @modules = grep {$_} split( '[\r\n]+', $param );
				# push @{ $self->{MODULE} }, @modules;
				for my $module ( @modules )
				{
					eval ( 'use '.$module.' ;' );
					if($@)
					{
						$self->{MODULE}{$module} = '0_ERR:'.$@;
						warn "ERR[include.$type $module]: $@";
					}
					else
					{
						$self->{MODULE}{$module} = '1_OK';
					}
				}
			}
			elsif(	$type eq 'parameters' and $ENV{MOD_PERL} )
			{

			     my $cgi = CGI->new();
			     
			     $param  =~ s/.*?a.*/pgceh/os unless
			     $param  =~ s/.*?A.*/PGCEH/os;
			     while( $param =~ m{([PGCEH])}icgos )
			     {
                    my  $param_key = $1;
                    my  $prefix = (uc($param_key) eq $param_key) ? $param_key.'_' : '';
                        $param_key = uc($param_key);
                        
                    if(     $param_key eq 'P' and $cgi->request_method() eq 'POST' ) { # POST
                        my @names = $cgi->param();
                        if(@names){
                        $self->Sourcer->Add( $prefix.'_NAMES' => join(',',@names) );
                        for(my $i=0; $i<=$#names; $i++ )
                        {
                            my  $parn = $names[$i];
                            my  $name = $prefix.$parn;
                            my  @vals = $cgi->param( $parn );
                            for my $val (@vals) {
                                $self->Sourcer->Add( $name => $val );
                            }
                        }
                        }
                    } 
                    elsif(  $param_key eq 'G' ) { # GET
                        my @names = $cgi->url_param();
                        if(@names){
                        $self->Sourcer->Add( $prefix.'_NAMES' => join(',',@names) );
                        for(my $i=0; $i<=$#names; $i++ )
                        {
                            my  $parn = $names[$i];
                            my  $name = $prefix.$parn;
                            my  @vals = $cgi->url_param( $parn );
                            for my $val (@vals) {
                                $self->Sourcer->Add( $name => $val );
                            }
                        }
                        }
                    } 
                    elsif(  $param_key eq 'C' ) { # COOKIE
                        my %cookies = CGI::Cookie->fetch();
                        for my $key ( keys %cookies )
                        {
                            my $name = $prefix.$key;
                            $self->Sourcer->Add( $name => $cookies{$key}->value() );
                        }
                    } 
                    elsif(  $param_key eq 'E' ) { # ENVIRONMENT
                        for my $key ( keys %ENV )
                        {
                            my $name = $prefix.$key;
                            $self->Sourcer->Add( $name => $ENV{$key} );
                        }
                    } 
                 }
			}
		}
        # for
	}
    # while
}


### ##########################################################################


### --------------------------------------------------------------------------
sub		HandleExtensions
### --------------------------------------------------------------------------
{
	my( $self  ) = @_;
    
	while( my @newValues = $self->Sourcer->NewValues() )
	{
		my	@jobs;

        # register new values before processing them
        value_loop:
		for my $command ( grep {/^!/} @newValues )
		{
		      #printf STDERR "command '%s'\n", $command;
		    my @command_keys = ( $command =~ /^!(\w+)(?:\.(\w+))?/ );
		      #printf STDERR "command keys '%s'\n", join(',',@command_keys);
		    next unless @command_keys;
		    #next if $command_keys[0] eq 'include';
		    my $sub_name;
		    select_sub_name: {
		      if( $command_keys[1] ) {
		      $sub_name = "DynaPage::Document::ext::$command_keys[0]::$command_keys[1]::PLUG";
		      last select_sub_name if  defined( &$sub_name );
		      }
		      
		      if( $command_keys[1] ) {
		      $sub_name = "DynaPage::Document::ext::$command_keys[0]::$command_keys[1]";
		      last select_sub_name if defined( &$sub_name );
		      }
		      
		      $sub_name = "DynaPage::Document::ext::$command_keys[0]::PLUG";
		      last select_sub_name if defined( &$sub_name );
		      
	            #printf STDERR "drop command '%s' keys '%s'\n", $command, join(',',@command_keys);
		      next value_loop;
            };
			my	$count	= $self->Sourcer->NewValues( $command );
			for my $param_index ( -$count..-1 )
			{
				my	$param = $self->Sourcer->Get( $command, $param_index );
				push @jobs, [ $sub_name, $command, $param ];
			}
		}#endfor

		$self->Sourcer->ClearStats();

		for my $job ( @jobs )
		{
			my $sub_name = shift @$job;
			  #printf STDERR "job %s('%s')\n", $sub_name, join(',',@$job);
			eval( $sub_name.'( $self, $job )' );
			warn "HandleExtensions job [$sub_name], ERR: '$@'" if $@;
			
		}#endfor
    }#endwhile
}

### ##########################################################################


### --------------------------------------------------------------------------
sub		Read
### --------------------------------------------------------------------------
{
	my( $self, $filename ) = @_;
    
		$filename	= $self->GetAbsFilename( "$filename" );

		unless( -r $filename )
		{
			push @{ $self->{ERROR} }, "Read: can't read file '$filename'";
			return undef;
		}

	$self->{FILE}{$filename}++;
	
	IO::File::String->new( "< $filename" )->load;
}


### ##########################################################################


### --------------------------------------------------------------------------
sub		Serialize
### --------------------------------------------------------------------------
{
	my( $self, $filename, @fields ) = @_;
	
	if( $filename ) {
        $filename = $self->GetAbsFilename( $filename )
    }

    unless(@fields){
        @fields=$self->Sourcer->Names();
    }
    
    my $serial = '';
    
    for my $field ( @fields )
    {
        for my $val ( $self->Get( $field )) {
            my $multiline = ( $val =~ /[\r\n]/ ) ? 1 : 0;
            if( $multiline ) {
                $serial .= sprintf "%s ==~\n%s\n~== %s\n", $field, $val, $field;
            }
            else {
                $serial .= sprintf "%s =~%s\n", $field, $val;
            }
        }
    }
    if($filename){
        return IO::File::String->new("> $filename")->save($serial);
    }
    else {
        return $serial;
    }
    
}

### ##########################################################################


### --------------------------------------------------------------------------
sub		GetAbsFilename
### --------------------------------------------------------------------------
{
	my( $self, $filename )=@_;
	
	my	$abs_filename;
	if(		$filename =~ s{^([/]+)}{} )
	{
		if( $1 eq '/' )
		{
			$abs_filename = File::Spec->rel2abs( $filename, $self->RootDir() );
		}
		else # '//'
		{
			$abs_filename	= File::Spec->catfile( '/', $filename );
		}
	}
	else
	{
		$abs_filename = File::Spec->rel2abs( $filename, $self->DocumentDir() );
	}
	
	$abs_filename
}


### ##########################################################################


### --------------------------------------------------------------------------
sub		RootDir
### --------------------------------------------------------------------------
{
	my( $self, $dir )=@_;
	
	if( $dir )
	{
		$self->{RootDir}	= File::Spec->rel2abs( $dir );
	}
	$self->{RootDir}
}


### ##########################################################################


### --------------------------------------------------------------------------
sub		DocumentDir
### --------------------------------------------------------------------------
{
	my( $self, $dir )=@_;
	
	if( $dir )
	{
		$self->{DocumentDir}	= File::Spec->rel2abs( $dir );
	}
	$self->{DocumentDir}
}




1;

__DATA__

__END__

### //////////////////////////////////////////////////////////////////////////
#
#	SECTION: TODO
#