SL/Webdav/Object.pm

   1 package SL::Webdav::Object;
   2
   3 use strict;
   4 use parent qw(Rose::Object);
   5
   6 use DateTime;
   7
   8 use Rose::Object::MakeMethods::Generic (
   9   scalar => [ qw(filename webdav) ],
  10   'scalar --get_set_init' => [ qw(version basename extension) ],
  11 );
  12
  13 sub init_basename {
  14   ($_[0]->parse_filename)[0];
  15 }
  16
  17 sub init_version {
  18   ($_[0]->parse_filename)[1];
  19 }
  20
  21 sub init_extension {
  22   ($_[0]->parse_filename)[2];
  23 }
  24
  25 sub parse_filename {
  26   my ($self) = @_;
  27
  28   my $name = $self->filename;
  29   my $version_re = $self->webdav->version_scheme->extract_regexp;
  30   my $sep        = $self->webdav->version_scheme->separator;
  31
  32   my $extension = $name =~ s/\.(\w+?)$//              ? $1 : '';
  33   my $version   = $name =~ s/\Q$sep\E($version_re)$// ? $1 : '';
  34   my $basename  = $name;
  35
  36   return ($basename, $version, $extension);
  37 }
  38
  39 sub full_filedescriptor {
  40   my ($self) = @_;
  41
  42   File::Spec->catfile($self->webdav->webdav_path, $self->filename);
  43 }
  44
  45 sub atime {
  46   DateTime->from_epoch(epoch => ($_[0]->stat)[8]);
  47 }
  48
  49 sub mtime {
  50   DateTime->from_epoch(epoch => ($_[0]->stat)[9]);
  51 }
  52
  53 sub data {
  54   my ($self) = @_;
  55
  56   open my $fh, '<:raw', $self->full_filedescriptor or die "could not open " . $self->filename . ": $!";
  57
  58   local $/ = undef;
  59
  60   my $data = <$fh>;
  61
  62   close $fh;
  63
  64   return \$data;
  65 }
  66
  67 sub stat {
  68   my $file = $_[0]->full_filedescriptor;
  69   stat($file);
  70 }
  71
  72 sub href {
  73   my ($self) = @_;
  74
  75   my $base_path = $ENV{'SCRIPT_NAME'};
  76   $base_path =~ s|[^/]+$||;
  77
  78   my $file         = $self->filename;
  79   my $path         = $self->webdav->webdav_path;
  80   my $is_directory = -d "$path/$file";
  81
  82   $file  = join('/', map { $::form->escape($_) } grep { $_ } split m|/+|, "$path/$file");
  83   $file .=  '/' if ($is_directory);
  84
  85   return "$base_path/$file";
  86 }
  87
  88 1;
  89
  90 __END__
  91
  92 =encoding utf-8
  93
  94 =head1 NAME
  95
  96 SL::Webdav::Object - Webdav object wrapper
  97
  98 =head1 SYNOPSIS
  99
 100   use SL::Webdav::Object;
 101
 102   my $object = SL::Webdav::Object->new(filename => $filename, webdav => $webdav);
 103
 104   my $data_ref  = $object->data;
 105   my $mtime     = $object->mtime;
 106
 107   my $basename  = $object->basename;
 108   my $version   = $object->version;
 109   my $extension = $object->extension;
 110
 111   my $link      = $object->href;
 112
 113 =head1 DESCRIPTION
 114
 115 This is a wrapper around a single object in the webdav. These objects are
 116 thought about as immutable, and all manipulation will instead happen in the
 117 associated L<SL::Webdav::File>.
 118
 119 =head1 FUNCTIONS
 120
 121 =over 4
 122
 123 =item C<basename>
 124
 125 Returns the basename with version and extension stripped.
 126
 127 =item C<version>
 128
 129 Returns the version string.
 130
 131 =item C<extension>
 132
 133 Returns the extension.
 134
 135 =item C<atime>
 136
 137 L<DateTime> wrapped stat[8]
 138
 139 =item C<mtime>
 140
 141 L<DateTime> wrapped stat[9]
 142
 143 =item C<data>
 144
 145 Ref to the actual data in raw encoding.
 146
 147 =item C<href>
 148
 149 URL relative to the web base dir for download.
 150
 151 =item C<full_filedescriptor>
 152
 153 Fully qualified path to file.
 154
 155 =back
 156
 157 =head1 SEE ALSO
 158
 159 L<SL::Webdav>, L<SL::Webdav::File>
 160
 161 =head1 BUGS
 162
 163 None yet :)
 164
 165 =head1 AUTHOR
 166
 167 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 168
 169 =cut