SL/Webdav/File.pm

   1 package SL::Webdav::File;
   2
   3 use strict;
   4 use parent qw(Rose::Object);
   5
   6 use File::Spec;
   7 use File::Copy ();
   8 use Carp;
   9
  10 use Rose::Object::MakeMethods::Generic (
  11   scalar => [ qw(webdav filename loaded) ],
  12   array  => [
  13     qw(objects),
  14     add_objects => { interface => 'push', hash_key => 'objects' },
  15   ],
  16 );
  17
  18 sub versions {
  19   $_[0]->load unless $_[0]->loaded;
  20   my $cmp = $_[0]->webdav->version_scheme->cmp;
  21   sort { $cmp->($a, $b) } $_[0]->objects;
  22 }
  23
  24 sub latest_version {
  25   ($_[0]->versions)[-1]
  26 }
  27
  28 sub load {
  29   my ($self) = @_;
  30   my @objects = $self->webdav->get_all_objects;
  31   my $ref = SL::Webdav::Object->new(filename => $self->filename, webdav => $self->webdav);
  32   my ($ref_basename, undef, $ref_extension) = $ref->parse_filename;
  33
  34   $self->objects(grep { $_->basename eq $ref_basename && $_->extension eq $ref_extension } @objects);
  35   $self->loaded(1);
  36 }
  37
  38 sub store {
  39   my ($self, %params) = @_;
  40
  41   croak 'Invalid call. Only data or file can be set' if ($params{data} && $params{file});
  42
  43   $self->load unless $self->loaded;
  44
  45   my $last = $self->latest_version;
  46   my $object;
  47
  48   if (!$last) {
  49     my ($basename, undef, $extension) = SL::Webdav::Object->new(filename => $self->filename, webdav => $self->webdav)->parse_filename;
  50     my $new_version  = $self->webdav->version_scheme->first_version;
  51     my $sep          = $self->webdav->version_scheme->separator;
  52     my $new_filename = $basename . $sep . $new_version . "." . $extension;
  53     $object = SL::Webdav::Object->new(filename => $new_filename, webdav => $self->webdav);
  54
  55     $self->add_objects($object);
  56   } else {
  57     if (!$self->webdav->version_scheme->keep_last_version($last)) {
  58       $params{new_version} = 1;
  59     }
  60
  61     # Do not create a new version of the document if file size of last version is the same.
  62     if ($params{new_version}) {
  63       my $last_file_size = $last->size;
  64       my $new_file_size;
  65       if ($params{file}) {
  66         croak 'No valid file' unless -f $params{file};
  67         $new_file_size  = (stat($params{file}))[7];
  68       } else {
  69         $new_file_size  = length(${ $params{data} });
  70       }
  71       $params{new_version} = 0 if $last_file_size == $new_file_size;
  72     }
  73
  74     if ($params{new_version}) {
  75       my $new_version  = $self->webdav->version_scheme->next_version($last);
  76       my $sep          = $self->webdav->version_scheme->separator;
  77       my $new_filename = $last->basename . $sep . $new_version . "." . $last->extension;
  78       $object = SL::Webdav::Object->new(filename => $new_filename, webdav => $self->webdav);
  79
  80       $self->add_objects($object);
  81     } else {
  82       $object = $last;
  83     }
  84   }
  85
  86   if ($params{file}) {
  87     croak 'No valid file' unless -f $params{file};
  88     File::Copy::copy($params{file}, $object->full_filedescriptor) or croak "Copy failed from $params{file} to @{[ $object->filename ]}: $!";
  89   } else {
  90
  91     open my $fh, '>:raw', $object->full_filedescriptor or die "could not open " . $object->filename . ": $!";
  92
  93     $fh->print(${ $params{data} });
  94
  95     close $fh;
  96   }
  97
  98
  99   return $object;
 100 }
 101
 102 1;
 103
 104 __END__
 105
 106 =encoding utf-8
 107
 108 =head1 NAME
 109
 110 SL::Webdav::File - Webdav file manipulation
 111
 112 =head1 SYNOPSIS
 113
 114   use SL::Webdav::File;
 115
 116   my $webdav_file = SL::Webdav::File->new(
 117     webdav   => $webdav,  # SL::Webdav instance
 118     filename => 'technical_drawing_AB28375.pdf',
 119   );
 120
 121   # get existing versioned files
 122   my @webdav_objects = $webdav_file->versions;
 123
 124   # store new version
 125   my $data = SL::Helper::CreatePDF->create_pdf(...);
 126   my $webdav_object = $webdav_file->store(data => \$data);
 127
 128   # use file instead of data
 129   my $webdav_object = $webdav_file->store(file => $path_to_file);
 130
 131   # force new version
 132   my $webdav_object = $webdav_file->store(data => \$data, new_version => 1);
 133
 134 =head1 DESCRIPTION
 135
 136 A file in this context is the collection of all versions of a single file saved
 137 into the webdav. This module provides methods to access and manipulate these
 138 objects.
 139
 140 =head1 FUNCTIONS
 141
 142 =over 4
 143
 144 =item C<versions>
 145
 146 Will return all L<SL::Webdav::Object>s found in this file, sorted by version
 147 according to the version scheme used.
 148
 149 =item C<latest_version>
 150
 151 Returns only the latest version object.
 152
 153 =item C<load>
 154
 155 Loads objects from disk.
 156
 157 =item C<store PARAMS>
 158
 159 Store a new version on disk. If C<data> is present, it is expected to contain a
 160 reference to the data to be written in raw encoding.
 161
 162 If C<file> is a valid filename then it will be copied.
 163
 164 C<file> and C<data> are exclusive.
 165
 166 If param C<new_version> is set, force a new version, even if the versioning
 167 scheme would keep the old one.
 168
 169 No new version is stored if the file or data size is euqal to the size of
 170 the last stored version.
 171
 172 =back
 173
 174 =head1 SEE ALSO
 175
 176 L<SL::Webdav>, L<SL::Webdav::Object>
 177
 178 =head1 BUGS
 179
 180 None yet :)
 181
 182 =head1 AUTHOR
 183
 184 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 185
 186 =cut