view release on metacpan or  search on metacpan

lib/CIPP/Runtime/Request.pm  view on Meta::CPAN

	1;
}

sub get_cipp_line_nr {
	my $self = shift;
	my %par = @_;
	my ($filename, $perl_line_nr) = @par{'filename','perl_line_nr'};

	my $cipp_line_nr;
	my $fh = FileHandle->new;
	if ( open ($fh, $filename) ) {
		my $i = 0;
		while (<$fh>) {
			if ( /^#\s+cipp_line_nr=(\d+)/ ) {
				$cipp_line_nr = $1;
			}
			++$i;
			last if $perl_line_nr == $i;
		}
		close $fh;
	}
	
	return $cipp_line_nr;
}

sub log {
	my $self = shift;
	my %par = @_;
	my  ($type, $message, $filename, $throw, $pre, $post) =
	@par{'type','message','filename','throw','pre','post'};

	$throw ||= "log";

	my $time = scalar (localtime);

	my $program = $self->get_program_name;

	my $msg = "$$\t$main::ENV{REMOTE_ADDR}\t$program\t$type\t$message";
	
	my $log_error;
	if ( $filename ne '' ) {
		# a relative path is interpreted relative to project log dir
		if ( $filename !~ m!^/! ) {
			$filename = $self->get_project_handle->get_log_dir."/$filename";
		}
		
	} else {
		$filename = $self->get_project_handle->get_log_file;
	}

	my $dir = dirname($filename);
	mkdir ($dir, 0775) if not -d $dir;

	my $fh = FileHandle->new;
	
	if ( open ($fh, ">> $filename") ) {
		if ( ! print $fh "$pre$time\t$msg\n$post" ) {
			$log_error = "Can't write data to '$filename'";
		}
		close $fh;
		chmod 0664, $filename;
	} else {
		$log_error = "Can't open file '$filename' for writing.";
	}
	
	croak "$throw\t$log_error" if $log_error;
	
	1;
}

sub init_error {
	my $self = shift;
	my %par = @_;
	my ($message) = @par{'message'};
	
	if ( not $self->get_http_header_printed ) {
		print "content-type: text/html\n\n";
	}

	print "Initialization Error\n";
	
	$self->exit;

	1;
}

sub exit {
	my $self = shift;
	die "_cipp_exit_command";
}

sub html_quote {
	shift;
        my ($text) = @_;

        $text =~ s/&/&amp;/g;
        $text =~ s/</&lt;/g;
        $text =~ s/>/&gt;/g;
        $text =~ s/\"/&quot;/g;

        return $text;
}

sub html_field_quote {
	shift;
        my ($text) = @_;

	$text =~ s/&/&amp;/g;
        $text =~ s/\"/&quot;/g;

        return $text;
}

sub url_encode {
	shift;
	my ($text) = @_;
	$text =~ s/(\W)/(ord($1)>15)?(sprintf("%%%x",ord($1))):("%0".sprintf("%lx",ord($1)))/eg;

	return $text;
}