The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#! /usr/bin/perl -w
################################################################################
#
# Storable.pm (Store a parsed PML Object)
#
################################################################################
#
# Package
#
################################################################################
package PML::Storable;
@ISA = qw( PML );
################################################################################
#
# Includes
#
################################################################################
use strict;
use Storable;
################################################################################
#
# Constants
#
################################################################################
use constant VERSION		=> '0.01';
use constant DATE		=> 'Mon Jun  5 15:29:33 2000';
use constant ID			=> '$Id: Storable.pm,v 1.3 2000/07/31 17:13:46 pjones Exp $';
################################################################################
#
# Global Variables and Default Settings
#
################################################################################
use vars qw($VERSION);
$VERSION	= VERSION;
################################################################################
#
# ==== new ==== ################################################################
#
#   Arguments:
#	1) Class
#	2) Args to PML->new
#
#     Returns:
#	A PML object reblessed as a PML::Storable Object
#
# Description:
#	Creates a new PML object then reblesses it as PML::Storable
#
################################################################################
sub new
{
	my $class = shift;
	my $self = new PML @_;
	
	return bless $self, $class;
} # <-- End new -->
################################################################################
#
# ==== parse ==== ##############################################################
#
#   Arguments:
#	1) Filename or ref to an array of lines
#
#     Returns:
#	None
#
# Description:
#	Checks to see if the object is up to date, if not it calls
#	PML::parse.
#
################################################################################
sub parse
{
	my ($self, $x) = (shift, @_);
	my ($stored_filename, $include, $mod);
	
	# we can't handle arrays or files that don't exist
	if (ref($x) eq 'ARRAY' or not -e $x) {
		return $self->SUPER::parse(@_);
	}
	
	# replace the dir seperator '/' with a '.'
	($stored_filename = $x) =~ s/\//./g;
	
	# add the obj dir to the front of the filename
	$stored_filename = $self->[PML->PML_OBJ_DIR] . '/' . $stored_filename;
	$stored_filename .= '.stored';
	
	# get the mod time of the obj
	$mod = -M $stored_filename;
	
	# see if the obj exists and that it is newer then the src
	if (not -e $stored_filename or $mod > -M $x) {
		$self->SUPER::parse(@_);
		return store $self, $stored_filename;
	}
	
	# if we get this far then we need to retrieve the stored obj
	my $obj = retrieve($stored_filename);
	
	# make sure we got it
	unless ($obj) {
		$self->SUPER::parse(@_);
		return store $self, $stored_filename;
	}
	
	# run through and check the dates on the included files
	foreach $include (keys %{$obj->[PML->PML_INCLUDES]}) {
		if (-M $include < $mod) {
			$self->SUPER::parse(@_);
			return store $self, $stored_filename;
		}
	}
	
	# if we get here then all include files are up to date
	# and we should load all the needed modules
	$self->parse_need($obj->[PML->PML_NEED_LIST]);
	
	# last we need to is copy over elements from obj to self
	foreach $x (0 .. 20) {
		$self->[$x] = $obj->[$x];
	}
	
	return 1;
} # <-- End parse -->
################################################################################
#                              END-OF-SCRIPT                                   #
################################################################################
=head1 NAME

Storable.pm

=head1 SYNOPSIS

Quick Usage

=head1 DESCRIPTION

What does it do?

=head1 OPTIONS

Long Usage

=head1 EXAMPLES

Example usage

=head1 SEE ALSO

perl(1)

=head1 AUTHOR

Peter J Jones
pjones@cpan.org

=cut
1;