view release on metacpan or  search on metacpan

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

	$self->check_options (
		mandatory => { 'var' => 1 },
		optional  => { 'my'  => 1 },
	) || return $RC;

	my $var = $self->parse_variable_option (
		option => 'var', types => [ 'scalar' ]
	) || return $RC;

	# prevent multiple <?!HTTPHEADER> instances
	if ( $self->get_state->{http_header_occured} ) {
		$self->add_tag_message (
			message => "Only one <?!HTTPHEADER> per program allowed.",
		);
		return $RC;
	}
	
	# only allowed in CGIs and Includes
	if ( $self->get_object_type ne 'cipp' and $self->get_object_type ne 'cipp-inc' ) {
		$self->add_tag_message (
			message => "<?!HTTPHEADER> only allowed inside Programs or Includes",
		);
		return $RC;
	}

	$self->get_state->{http_header_occured} = 1;

	# generate HTTP header code, like an Include subroutine
	$self->writef (
		q[sub {]."\n".
		q[  use strict;]."\n".
		q[  shift;]."\n".
#		q[  my $_cipp_line_nr;]."\n".
		q[  my %s = $CIPP::request->get_http_header;]."\n".
		q[  eval {]."\n",
		$var
	);

	return $RC;
}

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

	my $RC = $self->RC_BLOCK_TAG;

        if ( $self->get_current_tag_closed ) {
            $self->pop_context;
            $self->write("^)");
            $self->write(";\n") if $self->context eq 'perl';
            return $RC;
        }

	$self->check_options (
		mandatory => {},
		optional  => {},
	) || return $RC;
        
        $self->push_context('var_noquote');
        
        $self->write("CIPP->request->set_locale_messages_lang(qq^");
        
        return $RC;
}

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

	my $RC = $self->RC_BLOCK_TAG;

	if ( $self->get_current_tag_closed ) {
		$self->check_options (
			mandatory => {},
			optional  => {},
		) || return $RC;

		my $buffer_sref      = $self->close_output_buffer;
		my (undef, $options) = $self->pop_context;
		my $context          = $self->context;

                ${$buffer_sref} =~ s/^\s+//gm;
                ${$buffer_sref} =~ s/\s*$/ /gm;
                ${$buffer_sref} =~ s/\s+$//s;
		${$buffer_sref} =~ s/\^/\\^/g;
                ${$buffer_sref} =~ s/\s+/ /gs;

		$options ||= {};

		$self->write("print ") if $context ne 'perl' &&
				          $context !~ /^var/;
		$self->write("^.")     if $context eq 'var_quote';

                my $domain = $self->get_text_domain;

		if ( $options and keys %{$options} ) {
			my $options_hash = "{ ";
			while ( my ($k,$v) = each %{$options} ) {
				$v =~ s/\^/\\^/g;
				$options_hash .= "'$k' => qq^$v^, ";
			}
			$options_hash .= "}";
			$self->writef (
				qq[\$CIPP::request->dgettext("$domain",qq^%s^, $options_hash)],
				${$buffer_sref}
			);
		} else {
			$self->writef (
				qq[\$CIPP::request->dgettext("$domain",qq^%s^)],
				${$buffer_sref}
			);
		}

		$self->write(";\n") if $context ne 'perl' &&
				       $context !~ /^var/;
		$self->write(".qq^") if $context eq 'var_quote';

		return $RC;
	}

	$self->open_output_buffer;