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