SL/SessionFile.pm

   1 package SL::SessionFile;
   2
   3 use strict;
   4
   5 use parent qw(Rose::Object);
   6
   7 use Carp;
   8 use File::Path qw(mkpath rmtree);
   9 use English qw(-no_match_vars);
  10 use IO::File;
  11 use POSIX qw(strftime);
  12
  13 use Rose::Object::MakeMethods::Generic
  14 (
  15  scalar => [ qw(fh file_name) ],
  16  'scalar --get_set_init' => [ qw(session_id) ],
  17 );
  18
  19 sub new {
  20   my ($class, $file_name, %params) = @_;
  21
  22   my $self   = $class->SUPER::new;
  23
  24   if ($params{session_id}) {
  25     $self->session_id($params{session_id})
  26   }
  27
  28   my $path   = $self->prepare_path;
  29   $file_name =~ s:.*/::g;
  30   $file_name =  "${path}/${file_name}";
  31
  32   $self->file_name($file_name);
  33
  34   if ($params{mode}) {
  35     my $mode = $params{mode};
  36
  37     if ($params{encoding}) {
  38       $params{encoding} =~ s/[^a-z0-9\-]//gi;
  39       $mode .= ':encoding(' . $params{encoding} . ')';
  40     }
  41
  42     $self->fh(IO::File->new($file_name, $mode));
  43   }
  44
  45   return $self;
  46 }
  47
  48 sub open {
  49   my ($self, $mode) = @_;
  50   return $self->fh(IO::File->new($self->file_name, $mode));
  51 }
  52
  53 sub exists {
  54   my ($self) = @_;
  55   return -f $self->file_name;
  56 }
  57
  58 sub size {
  59   my ($self) = @_;
  60   return -s $self->file_name;
  61 }
  62
  63 sub displayable_mtime {
  64   my ($self) = @_;
  65   return '' unless $self->exists;
  66
  67   my @mtime = localtime((stat $self->file_name)[9]);
  68   return $::locale->format_date(\%::myconfig, $mtime[5] + 1900, $mtime[4] + 1, $mtime[3]) . ' ' . strftime('%H:%M:%S', @mtime);
  69 }
  70
  71 sub get_path {
  72   die "No session ID" unless $_[0]->session_id;
  73   return "users/session_files/" . $_[0]->session_id;
  74 }
  75
  76 sub prepare_path {
  77   my $path = $_[0]->get_path;
  78   return $path if -d $path;
  79   mkpath $path;
  80   die "Creating ${path} failed" unless -d $path;
  81   return $path;
  82 }
  83
  84 sub init_session_id {
  85   $::auth->get_session_id;
  86 }
  87
  88 sub destroy_session {
  89   my ($class, $session_id) = @_;
  90
  91   $session_id =~ s/[^a-z0-9]//gi;
  92   rmtree "users/session_files/$session_id" if $session_id;
  93 }
  94
  95 1;
  96 __END__
  97
  98 =pod
  99
 100 =encoding utf8
 101
 102 =head1 NAME
 103
 104 SL::SessionFile - Create files that are removed when the session is
 105 destroyed or expires
 106
 107 =head1 SYNOPSIS
 108
 109   use SL::SessionFile;
 110
 111   # Create a session file named "customer.csv" (relative names only)
 112   my $sfile = SL::SessionFile->new('customer.csv', mode => 'w');
 113   $sfile->fh->print("col1;col2;col3\n" .
 114                     "value1;value2;value3\n");
 115   $sfile->fh->close;
 116
 117   # Does temporary file exist?
 118   my $sfile = SL::SessionFile->new("customer.csv");
 119   if ($sfile->exists) {
 120     print "file exists; size " . $sfile->size . " bytes; mtime " . $sfile->displayable_mtime . "\n";
 121   }
 122
 123 A small class that wraps around files that only exist as long as the
 124 user's session exists. The session expiration mechanism will delete
 125 all session files when the session itself is removed due to expiry or
 126 the user logging out.
 127
 128 Files are stored in session-specific folders in
 129 C<users/session_files/SESSIONID>.
 130
 131 =head1 MEMBER FUNCTIONS
 132
 133 =over 4
 134
 135 =item C<new $file_name, [%params]>
 136
 137 Create a new instance. C<$file_name> is a relative file name (path
 138 components are stripped) to the session-specific temporary directory.
 139
 140 If C<$params{mode}> is given then try to open the file as an instance
 141 of C<IO::File>. C<${mode}> is passed through to C<IO::File::new>.
 142
 143 If C<$params{encoding}> is given then the file is opened with the
 144 appropriate encoding layer.
 145
 146 =item C<fh>
 147
 148 Returns the instance of C<IO::File> associated with the file.
 149
 150 =item C<file_name>
 151
 152 Returns the full relative file name associated with this instance. If
 153 it has been created for "customer.csv" then the value returned might
 154 be C<users/session_files/e8789b98721347/customer.csv>.
 155
 156 =item C<open, %params]>
 157
 158 Opens the file_name given at creation with the given parameters.
 159
 160 =item C<exists>
 161
 162 Returns trueish if the file exists.
 163
 164 =item C<size>
 165
 166 Returns the file's size in bytes.
 167
 168 =item C<displayable_mtime>
 169
 170 Returns the modification time suitable for display (e.g. date
 171 formatted according to the user's date format), e.g.
 172 C<22.01.2011 14:12:22>.
 173
 174 =back
 175
 176 =head1 OBJECT FUNCTIONS
 177
 178 =over 4
 179
 180 =item C<get_path>
 181
 182 Returns the name of the session-specific directory used for file
 183 storage relative to the kivitendo installation folder.
 184
 185 =item C<prepare_path>
 186
 187 Creates all directories in C<get_path> if they do not exist. Returns
 188 the same as C<get_path>.
 189
 190 =item C<destroy_session $id>
 191
 192 Removes all files and the directory belonging to the session C<$id>.
 193
 194 =back
 195
 196 =head1 BUGS
 197
 198 Nothing here yet.
 199
 200 =head1 AUTHOR
 201
 202 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 203
 204 =cut