view release on metacpan or  search on metacpan

lib/Apache2/PageKit.pm  view on Meta::CPAN

  # set up page template and run component code
  my $output_ref = $view->fill_in_view;

  # determine output media type
  my $pkit_view = $apr->param('pkit_view') || 'Default';
  my $output_media = $config->get_page_attr($page_id, 'content_type')
    || $config->get_view_attr($pkit_view, 'content_type')
    || $Apache2::PageKit::DefaultMediaMap{$pkit_view}
    || 'text/html';

  # set expires to now so prevent caching
  #$apr->no_cache(1) if $apr->param('pkit_logout') || $config->get_page_attr($pk->{page_id},'template_cache') eq 'no';
  # see http://support.microsoft.com/support/kb/articles/Q234/0/67.ASP
  # and http://www.pacificnet.net/~johnr/meta.html
  my $browser_cache =  $config->get_page_attr($page_id,'browser_cache') || $pk->{browser_cache} || 'yes';
  $apr->headers_out->{'Expires'} = '-1' if $apr->param('pkit_logout') || $browser_cache eq 'no' || $apr->user;

  my $content_type = $output_media;
  
  my $default_output_charset = $view->{default_output_charset};
  my @charsets = ();
  if($output_media eq 'text/html'){
    # first get accepted charsets from incoming Accept-Charset HTTP header
    if(my $accept_charset = $apr->headers_in->{'Accept-Charset'}){
      my @quality = split(/\s*;\s*/, $accept_charset);
      my @accept_charsets = split(/\s*,\s*/, shift @quality);
      my $pos = 0;
      for ( @accept_charsets ) {
        s/^(iso|utf)/\U$1/;
        s/^(us\-)?ascii/US-ASCII/;
	$quality[$pos] =~ /^q=(\d+(?:\.\d+)?)/;
	push @charsets, [ $_, $1 || '0.1', $pos++ ];
      }
      @charsets = sort {$b->[1] <=> $a->[1] || $a->[2] <=> $b->[2] } @charsets;
     
     # set a content-type perhaps we overwrite this later if we know about the charset for the output pages
    }
  } elsif ($output_media eq 'application/pdf'){
    
    my $fop_command = $config->get_server_attr('fop_command') 
      || $config->get_global_attr('fop_command');

    if ( $fop_command ) {
      # write output_media to file, using process number of Apache child process
      my $view_cache_dir = $view->{cache_dir};
      my $fo_file = "$view_cache_dir/$$.fo";
      my $pdf_file = "$view_cache_dir/$$.pdf";
      open FO_TEMPLATE, ">$fo_file" or die "can't open file: $fo_file ($!)";
      binmode FO_TEMPLATE;
      print FO_TEMPLATE $$output_ref;
      close FO_TEMPLATE;
      
      #   my $error_message = `$fop_command $fo_file $pdf_file 2>&1 1>/dev/null`;
      my $error_message = `$fop_command $fo_file $pdf_file 2>&1`;

      ## the recommended fop converter has no usefull error messages.
      ## the errormoessages go also to STDOUT
      ## and the returncode is always 0
      unless ($error_message =~ /^\[ERROR\]:/m){
        local $/;
        open PDF_OUTPUT, "<$pdf_file" or die "can't open file: $pdf_file ($!)";
        binmode PDF_OUTPUT;
        $$output_ref = <PDF_OUTPUT>;
        close PDF_OUTPUT;
      } 
      else {
        die "Error processing template with Apache XML FOP: $error_message";
      }
    }
  } else {
    # just set content_type but it is already $output_media
    ;
  }

  # for a head request
  if ($apr->header_only) {
    $apr->content_type($content_type);
    return;
  }

  # call output filter, if applicable
  $model->pkit_output_filter($output_ref)
    if $model->can('pkit_output_filter');

  my ( $converted_data, $retcharset );
  if ($output_media eq 'text/html'){
    my $data;
    while (@charsets){
      $retcharset = (shift @charsets)->[0];
      eval {
        $converted_data = Encode::encode($retcharset, $$output_ref, Encode::FB_CROAK );
      };
      last unless ($@);
      $retcharset = undef;
    }

    ## here no action is needed, if we did not convert the data to anything usefull.
    ## we deliver in our default_output_charset.

    # correct the header
    if ($retcharset) {
      $content_type = "text/html; charset=$retcharset";
    }
    else {
      $content_type = "text/html; charset=$default_output_charset";
      $converted_data = Encode::encode( $default_output_charset, $$output_ref,Encode::FB_DEFAULT );
    }
    # it is already "text/html"
  }

  # only pages with propper $retcharset are tranfered gzipped.
  # this can maybe changed!? Needs some tests
  my $send_gzipped = ( $retcharset && $pk->{use_gzip} eq 'all' );
  $apr->content_encoding('gzip') if ($send_gzipped);

  $apr->content_type($content_type) unless $apr->main;

  if ($send_gzipped) {
    $apr->print(Compress::Zlib::memGzip($converted_data || $$output_ref));
  } else {
    $apr->print($converted_data || $$output_ref);
  }
}