The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Archive::Builder::File;

# This package represents a single file in the Archive::Builder structure

use strict;
use Scalar::Util     ();
use Params::Util     ('_SCALAR0');
use Archive::Builder ();

use vars qw{$VERSION %_PARENT};
BEGIN {
	$VERSION = '1.16';
	%_PARENT = ();
}





#####################################################################
# Main Interface Methods

sub new {
	my $class = shift;
	$class->_clear;

	# Get and check the path
	my $path = Archive::Builder->_check( 'relative path', $_[0] ) ? shift
		: return $class->_error( 'Invalid path format for File creation' );

	# Get and check the Archive::Builder function
	my $generator = Archive::Builder->_check( 'generator', $_[0] ) ? shift
		: return $class->_error( 'Invalid generator function: '
			. Archive::Builder->errstr );

	# Create the File object
	bless {
		path      => $path,
		generator => $generator,
		arguments => @_ ? [ @_ ] : 0,
	}, $class;
}

# Accessor methods
sub path      { $_[0]->{path} }
sub generator { $_[0]->{generator} }
sub arguments { $_[0]->{arguments} ? [@{ $_[0]->{arguments} }] : 0 }

# Save the file to disk ( optionally below a directory )
sub save {
	my $self = shift;
	my $filename = shift or return undef;

	# Can we write to the location
	unless ( File::Flat->canWrite( $filename ) ) {
		return $self->_error( "Insufficient permissions to write to '$filename'" );
	}

	# Get the file contents ( as a scalar ref )
	my $contents = $self->contents or return undef;

	# Write the file
	File::Flat->write( $filename, $contents )
		or return $self->_error( "Error writing to '$filename': $!" );

	# If it is executable, set the mode
	if ( $self->{executable} ) {
		chmod 0755, $filename;
	}

	1;
}

# Is the file binary. Worked out by examining the content for the null byte,
# which should never be in a text file, but almost always is in binary files.
sub binary {
	my $self = shift;
	my $contents = $self->contents or return undef;
	index($$contents, "\000") != -1;
}

# Flag a File as being executable
sub executable { $_[0]->{executable} = 1 }

# Get our parent Section
sub Section { $_PARENT{ Scalar::Util::refaddr($_[0]) } }

# Delete this from from its parent
sub delete {
	my $self = shift;
	my $Section = $self->Section or return 1;

	# Remove from our parent
	$Section->remove_file( $self->path );

	1;
}	

# If the content has been generated, remove it so it will
# be generated again. ( Possibly with a different result )
sub reset { delete $_[0]->{contents}; 1 }





######################################################################
# File generation

# Get the generated content.
# Implement caching.
sub contents {
	my $self = shift;
	unless ( exists $self->{contents} ) {
		my $contents = $self->_contents;
		unless ( defined $contents ) {
			return $self->_error( 'Error while generating contents: ' . $self->errstr );
		}
		$self->{contents} = $contents;
	}
	$self->{contents};
}

# Actually generate the contents
sub _contents {
	my $self = shift;

	# Load the module for the function if needed
	my $generator = $self->{generator} =~ /::/
		? $self->{generator}
		: "Archive::Builder::Generators::$self->{generator}";
	my ($module) = $generator =~ m/^(.*)::.*$/;
	unless ( Class::Autouse->load( $module ) ) {
		return $self->_error( "Failed to load module '$module'" );
	}

	# Call the function
	no strict 'refs';
	my $result = $self->{arguments}
		? &{ $generator }( $self, @{ $self->{arguments} } )
		: &{ $generator }( $self );
	_SCALAR0($result) or return undef;

	# Clean up newlines in text files
	if ( index($$result, "\000") == -1 ) { # If not a binary file
		$$result =~ s/(?:\015\012|\015|\012)/\n/g;
	}
	
	$result;
}





#####################################################################
# Utility Methods

# Pass through error
sub errstr { Archive::Builder->errstr }
sub _error { shift; Archive::Builder->_error(@_) }
sub _clear { Archive::Builder->_clear }

1;

__END__

=pod

The documentation for this class is part of L<Archive::Builder>.

=cut