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