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