view release on metacpan or  search on metacpan

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

  # User defined base model class
  my $model_base_class = $config->get_global_attr('model_base_class') || "MyPageKit::Common";
  eval "require $model_base_class";
  if($@){
    die "Failed to load $model_base_class ($@)";
  }

  # User defined session class
  for ( qw /session_class page_session_class/ ) {
    my $user_session_class = $config->get_global_attr($_) || next;
    eval "require $user_session_class";
    $@ && die "Failed to load $user_session_class ($@)";
  }

  # User defined template toolkit class
  my $template_class = $config->get_global_attr('template_class');
  if ( $template_class ) {
    eval "require $template_class";
    $@ && die "Failed to load $template_class ($@)";
  }

  # delete all cache files, since some of them might be stale
  # and might not be checked for freshness, if reload is off
  # even if reload is on, PageKit might change, so it should be refreshed
  my $unlink_sub = sub {
    -f && unlink;
  };
  File::Find::find($unlink_sub,$view_cache_dir);

  # init gettext
  if (($config->get_global_attr('use_locale') || 'no') eq 'yes') {
    eval { require Locale::gettext };

    unless ($@) {

      # check for broken locale settings
      delete @ENV{qw/LANG LANGUAGE LC_ALL/};

      $ENV{LC_MESSAGES} = $config->get_global_attr('default_lang') || 'en';

      # ( my $textdomain ) = $config->get_global_attr('model_base_class') =~ m/^([^:]+)/;
      my $textdomain = 'PageKit';
      Locale::gettext::bindtextdomain($textdomain, $pkit_root . '/locale');
      Locale::gettext::textdomain($textdomain);
    }
    else {
      warn "Locale::gettext not installed ($@)";
    }
  }

  $model_base_class->pkit_startup($pkit_root, $server, $config)
    if $model_base_class->can('pkit_startup');
}

# object oriented method call, see Eagle p.65
sub handler : method {
  my ( $class, $requestrec ) =  @_ ;
  my ($pk, $model, $status_code);

  binmode STDOUT;
  $| = 1;

  eval {
    $pk = $class->new( $requestrec );
    $model = $pk->{model};
    my $apr = $pk->{apr};
    my $view = $pk->{view};
    my $config = $pk->{config};
    $status_code = $pk->prepare_page;
    my $use_template = $config->get_page_attr($pk->{page_id},'use_template') || 'yes' if ($status_code eq OK);
    if ($status_code eq OK && $use_template ne 'no'){
      COMPONENT: {
        $pk->open_view;
#        for my $component_id (@{$view->{record}->{component_ids}}){
#	  $pk->component_code($component_id);
	local $pk->{component_params_hashref};
        for my $component_id_params_ref (@{$view->{record}->{component_ids}}){
	  $pk->{component_params_hashref} = $component_id_params_ref->[1];
	  $pk->component_code($component_id_params_ref->[0]);
          if ( defined $pk->{status_code} ) {
            $status_code = $pk->{status_code};
            last COMPONENT;
          }
        }
        $model->pkit_post_common_code if $model->can('pkit_post_common_code');
        $pk->set_session_cookie;
        $pk->prepare_and_print_view;
      }
    }

  };
  
  if ( $pk ) {
    
    $status_code = $pk->_fatal_error($@) if ( $@ );

    # save changes
    delete @$pk{qw/session page_session/};
  }

  # the session and page_session references can not be used
  # inside pkit_cleanup_code -- they are already deleted
  $model->pkit_cleanup_code if $model && $model->can('pkit_cleanup_code');

  if($@ and !$pk){
    if(exists $INC{'Apache/ErrorReport.pm'}){
      Apache2::ErrorReport::fatal($@);
    }
    die $@;
  }

  return $status_code || OK;
}

# called in case die is trapped by eval
sub _fatal_error {
  my ($pk, $error) = @_;
  my $model = $pk->{model};
  eval {
    $error = $model->pkit_on_error($error) if $model->can('pkit_on_error');

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

    shift @fillinform_objects_array;
  }
  $view->{fillinform_objects} = [ grep {$_->param} @fillinform_objects_array ];
  $view->{ignore_fillinform_fields} = $pk->{ignore_fillinform_fields};

  my $request_param_in_tmpl = $config->get_page_attr($page_id,'request_param_in_tmpl')
    || $config->get_global_attr('request_param_in_tmpl')
    || 'no';
  if( $request_param_in_tmpl eq 'yes' ) {
    $view->{associated_objects} = [$apr];
  }

  # 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);
  }