view release on metacpan or  search on metacpan

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

sub _fatal_error {
  my ($pk, $error) = @_;
  my $model = $pk->{model};
  eval {
    $error = $model->pkit_on_error($error) if $model->can('pkit_on_error');
  };
  # just in case we die again inside pkit_on_error
  $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->can('pkit_cleanup_code');
  if( exists $INC{'Apache/ErrorReport.pm'} && $error ){
    Apache::ErrorReport::fatal($error);
  }
  die $error if $error;

  return ( defined $pk->{status_code} ? $pk->{status_code} : undef );
}

# utility function, concats parameters from request parameters into string
# seperated by '&' and '=' - suitable for displaying in a URL
sub params_as_string {
  my ($apr, $exclude_param) = @_;

  my $args;
  # we cache args in pnotes - i think it is faster this way
  # especially if you have <PKIT_SELFURL exclude="foo"> tags
  unless ($args = $apr->pnotes('r_args')){

    # this fine easy line is replaced with this beast to parse url's
    # like http://ka.brain.de/login2?passwd=ss&&&&submit&&login=s&
    #  my %args = $apr->args;
    my %args = ();
    my @args = $apr->args;
    while (@args) {
      my $k = shift @args;
      next unless $k;
      $args{$k} = shift @args;
    }

    for (qw(login logout view check_cookie messages error_messages lang)){
      delete $args{"pkit_$_"};
    }
    $args = \%args;
    $apr->pnotes(r_args => $args);
  }

  if($exclude_param && @$exclude_param){
    my %exclude_param_hash = map {$_ => 1} @$exclude_param;
    return join ('&', map { Apache::Util::escape_uri("$_") ."=" . Apache::Util::escape_uri(defined($args->{$_}) ? $args->{$_} : "")}
       grep {!exists $exclude_param_hash{$_}} keys %$args);
  } else {
    return join ('&', map { Apache::Util::escape_uri("$_") ."=" . Apache::Util::escape_uri(defined($args->{$_}) ? $args->{$_} : "")} keys %$args);
  }
}

sub update_session {
  my ($pk, $auth_session_id) = @_;
  # keep recent sessions recent, if user is logged in
  # that is sessions time out if user hasn't viewed in a page
  # in recent_login_timeout seconds
  my $session = $pk->{session};
  return unless defined($session);

  unless(exists($session->{pkit_inactivity_timeout})){
    my $recent_login_timeout = $pk->{config}->get_global_attr('recent_login_timeout') || 3600;
    my $last_activity = $session->{pkit_last_activity};
    if(defined($last_activity) && $last_activity + $recent_login_timeout < time()){
      # user has been inactive for recent_login_timeout seconds, timeout
      $session->{pkit_inactivity_timeout} = 1;
    } else {
      # update last_activity timestamp
      $session->{pkit_last_activity} = time();
    }
  }
}

sub load_page_session {
  my ( $pk, $ss ) = @_;

  $ss ||= $pk->{model}->pkit_session_setup;

  my $config = $pk->{config};
  my $want_page_session = $config->get_page_attr($pk->{page_id}, 'page_session')
    || $config->get_global_attr('page_session') || 'no';

  if ( $want_page_session eq 'yes' ) {

    my ( %page_session, $secret );
    {
      no strict 'refs';
      $secret = ${ $config->get_global_attr('model_base_class') . '::secret_md5' };
    }

    my $page_session_class = $config->get_global_attr('page_session_class') || 'Apache::SessionX';

    tie %page_session, $page_session_class, Digest::MD5::md5_hex( $secret, $pk->{page_id} ),
    {
      Lock => $ss->{session_lock_class},
      Store => $ss->{session_store_class},
      Generate => 'MD5',
      Serialize => $ss->{session_serialize_class} || 'Storable',
      create_unknown => 1,
      lazy => 1,
      %{$ss->{session_args}}
    };
    $pk->{page_session} = \%page_session;
  }
}

sub prepare_page {
  my $pk = shift;

  # $apr is an Apache::Request object, derived from Apache request object
  my $apr = $pk->{apr};

  # $view is an Apache::PageKit::View object