projekt kivitendo

    next if defined $form->{$ref->{sess_key}};

    my $params                = $self->_load_value($ref->{sess_value});

    $form->{$ref->{sess_key}} = $params->{data} if $params->{auto_restore} || $params->{simple};

  my ($self, $value) = @_;

  return { simple => 1, data => $value } if $value !~ m/^---/;

  my %params = ( simple => 1 );

    my $data = YAML::Load($value);

    if (ref $data eq 'HASH') {

      map { $params{$_} = $data->{$_} } keys %{ $data };

      $params{simple} = 0;

    } else {

      $params{data}   = $data;

    }

  } or $params{data} = $value;

  return \%params;

    $self->{SESSION}->{ $key } = YAML::Dump(ref($value) eq 'HASH' ? { data => $value } : $value);

  my $self   = shift;

  my $params = $self->{SESSION} ? $self->_load_value($self->{SESSION}->{ $_[0] }) : {};

  return $params->{data};

}

sub create_unique_sesion_value {

  my ($self, $value, %params) = @_;

  $self->{SESSION} ||= { };

  my @now                   = gettimeofday();

  my $key                   = "$$-" . ($now[0] * 1000000 + $now[1]) . "-";

  $self->{unique_counter} ||= 0;

  $self->{unique_counter}++ while exists $self->{SESSION}->{$key . $self->{unique_counter}};

  $self->{unique_counter}++;

  $value  = { expiration => $params{expiration} ? ($now[0] + $params{expiration}) * 1000000 + $now[1] : undef,

              no_auto    => !$params{auto_restore},

              data       => $value,

            };

  $self->{SESSION}->{$key . $self->{unique_counter}} = YAML::Dump($value);

  return $key . $self->{unique_counter};

}

sub save_form_in_session {

  my ($self, %params) = @_;

  my $form        = delete($params{form}) || $::form;

  my $non_scalars = delete $params{non_scalars};

  my $data        = {};

  my %skip_keys   = map { ( $_ => 1 ) } (qw(login password stylesheet version titlebar), @{ $params{skip_keys} || [] });

  foreach my $key (grep { !$skip_keys{$_} } keys %{ $form }) {

    $data->{$key} = $form->{$key} if !ref($form->{$key}) || $non_scalars;

  }

  return $self->create_unique_sesion_value($data, %params);

}

sub restore_form_from_session {

  my ($self, $key, %params) = @_;

  my $data = $self->get_session_value($key);

  return $self unless $data;

  my $form    = delete($params{form}) || $::form;

  my $clobber = exists $params{clobber} ? $params{clobber} : 1;

  map { $form->{$_} = $data->{$_} if $clobber || !exists $form->{$_} } keys %{ $data };

  return $self;

}

sub expire_session_keys {

  my ($self) = @_;

  $self->{SESSION} ||= { };

  my @now = gettimeofday();

  my $now = $now[0] * 1000000 + $now[1];

  $self->delete_session_value(map  { $_->[0]                                                 }

                              grep { $_->[1]->{expiration} && ($now > $_->[1]->{expiration}) }

                              map  { [ $_, $self->_load_value($self->{SESSION}->{$_}) ]      }

                              keys %{ $self->{SESSION} });

  return $self;

}

sub _has_expiration {

  my ($value) = @_;

  return (ref $value eq 'HASH') && exists($value->{expiration}) && $value->{data};

__END__

=pod

=encoding utf8

=head1 NAME

SL::Auth - Authentication and session handling

=head1 FUNCTIONS

=over 4

=item C<set_session_value %values>

Store all key/value pairs in C<%values> in the session. All of these

values are copied back into C<$::form> in the next request

automatically.

The values can be any Perl structure. They are stored as YAML dumps.

=item C<get_session_value $key>

Retrieve a value from the session. Returns C<undef> if the value

doesn't exist.

=item C<create_unique_sesion_value $value, %params>

Create a unique key in the session and store C<$value>

there.

If C<$params{expiration}> is set then it is interpreted as a number of

seconds after which the value is removed from the session. It will

never expire if that parameter is falsish.

If C<$params{auto_restore}> is trueish then the value will be copied

into C<$::form> upon the next request automatically. It defaults to

C<false> and has therefore different behaviour than

L</set_session_value>.

Returns the key created in the session.

=item C<expire_session_keys>

Removes all keys from the session that have an expiration time set and

whose expiration time is in the past.

=item C<save_session>

Stores the session values in the database. This is the only function

that actually stores stuff in the database. Neither the various

setters nor the deleter access the database.

=item <save_form_in_session %params>

Stores the content of C<$params{form}> (default: C<$::form>) in the

session using L</create_unique_sesion_value>.

If C<$params{non_scalars}> is trueish then non-scalar values will be

stored as well. Default is to only store scalar values.

The following keys will never be saved: C<login>, C<password>,

C<stylesheet>, C<titlebar>, C<version>. Additional keys not to save

can be given as an array ref in C<$params{skip_keys}>.

Returns the unique key under which the form is stored.

=item <restore_form_from_session $key, %params>

Restores the form from the session into C<$params{form}> (default:

C<$::form>).

If C<$params{clobber}> is falsish then existing values with the same

key in C<$params{form}> will not be overwritten. C<$params{clobber}>

is on by default.

Returns C<$self>.

=back

=head1 BUGS

Nothing here yet.

=head1 AUTHOR

Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>

=cut