view release on metacpan or  search on metacpan

lib/CIPP/Compile/Parser.pm  view on Meta::CPAN

	printf $fh (@_);
	1;
}

sub open_files {
	my $self = shift; $self->trace_in;
	
	my $filename;
	my $fh;

	$filename = $self->get_in_filename;
	$fh = FileHandle->new;

	if ( open ($fh, $filename) ) {
		$self->set_in_fh ($fh);
	} else {
		$self->add_message (
			message => "Can't read input file '$filename': $!"
		);
	}

	$filename = $self->get_out_filename;
	$self->make_path($filename);
	$fh = FileHandle->new;
	if ( open ($fh, ">$filename") ) {
		$self->set_out_fh ($fh);
	} else {
		$self->add_message (
			message => "Can't write output file '$filename': $!"
		);
	}

	1;
}

sub close_files {
	my $self = shift; $self->trace_in;
	
	close ($self->get_in_fh);
	close ($self->get_out_fh);

	1;
}

sub install_file {
	my $self = shift; $self->trace_in;

	if ( $self->has_errors ) {
		move ($self->get_out_filename, $self->get_err_copy_filename);
		unlink  $self->get_dep_filename;
		unlink  $self->get_iface_filename
			if $self->get_iface_filename;
		return;
	}

	unlink $self->get_err_copy_filename;

	my $object_type = $self->get_object_type;

	if ( $object_type eq 'cipp' )  {
		chmod 0775, $self->get_out_filename;

	} elsif ( $object_type eq 'cipp-inc' ) { 
		chmod 0664, $self->get_out_filename;

	} elsif ( $object_type eq 'cipp-module' ) {
		my $tmp_module_file = $self->get_out_filename;
		my $prod_filename;
		(undef, undef, $prod_filename) = $self->get_object_filenames;
		$self->set_prod_filename ( $prod_filename );

		my $prod_dir = dirname($prod_filename);
		if ( not -d $prod_dir ) {
			mkpath ([$prod_dir], 0, 0775) or $self->add_message (
				line_nr => 0,
				message => "Can't create dir $prod_dir"
			);
		}

		if ( -d $prod_dir and not move ($tmp_module_file, $prod_filename) ) {
			$self->add_message (
				line_nr => 0,
				message => "Can't move '$tmp_module_file' to ".
					   "'$prod_filename': $!"
			);
		}

	} elsif ( $object_type eq 'cipp-html' ) {
		# ->perl_error_check will execute the generated
		# perl program and install its output to

		unlink $self->get_out_filename;

	} else {
		confess "Unknown object type '$object_type'";
	}

	# delete http_file if no <?!HTTPHEADER> occured
	if ( not $self->get_state->{http_header_occured} ) {
		unlink ($self->get_http_filename);
	}

	1;
}

sub make_path {
	my $self = shift; $self->trace_in;
	
	my ($filename) = @_;
	my $dir = dirname $filename;
	
	return if -d $dir;

	mkpath ($dir, 0, 0770)
		or confess "can't mkpath '$dir': $!";
	
	1;
}

sub cache_is_clean {
	my $self = shift;

	return if $self->get_dont_cache;