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 size {
  46   ($_[0]->stat)[7];
  47 }
  48
  49 sub atime {
  50   DateTime->from_epoch(epoch => ($_[0]->stat)[8]);
  51 }
  52
  53 sub mtime {
  54   DateTime->from_epoch(epoch => ($_[0]->stat)[9]);
  55 }
  56
  57 sub data {
  58   my ($self) = @_;
  59
  60   open my $fh, '<:raw', $self->full_filedescriptor or die "could not open " . $self->filename . ": $!";
  61
  62   local $/ = undef;
  63
  64   my $data = <$fh>;
  65
  66   close $fh;
  67
  68   return \$data;
  69 }
  70
  71 sub stat {
  72   my $file = $_[0]->full_filedescriptor;
  73   stat($file);
  74 }
  75
  76 sub href {
  77   my ($self) = @_;
  78
  79   my $base_path = $ENV{'SCRIPT_NAME'};
  80   $base_path =~ s|[^/]+$||;
  81
  82   my $file         = $self->filename;
  83   my $path         = $self->webdav->webdav_path;
  84   my $is_directory = -d "$path/$file";
  85
  86   $file  = join('/', map { $::form->escape($_) } grep { $_ } split m|/+|, "$path/$file");
  87   $file .=  '/' if ($is_directory);
  88
  89   return "$base_path/$file";
  90 }
  91
  92 1;
  93
  94 __END__
  95
  96 =encoding utf-8
  97
  98 =head1 NAME
  99
 100 SL::Webdav::Object - Webdav object wrapper
 101
 102 =head1 SYNOPSIS
 103
 104   use SL::Webdav::Object;
 105
 106   my $object = SL::Webdav::Object->new(filename => $filename, webdav => $webdav);
 107
 108   my $data_ref  = $object->data;
 109   my $mtime     = $object->mtime;
 110
 111   my $basename  = $object->basename;
 112   my $version   = $object->version;
 113   my $extension = $object->extension;
 114
 115   my $link      = $object->href;
 116
 117 =head1 DESCRIPTION
 118
 119 This is a wrapper around a single object in the webdav. These objects are
 120 thought about as immutable, and all manipulation will instead happen in the
 121 associated L<SL::Webdav::File>.
 122
 123 =head1 FUNCTIONS
 124
 125 =over 4
 126
 127 =item C<basename>
 128
 129 Returns the basename with version and extension stripped.
 130
 131 =item C<version>
 132
 133 Returns the version string.
 134
 135 =item C<extension>
 136
 137 Returns the extension.
 138
 139 =item C<size>
 140
 141 wrapped stat[7]
 142
 143 =item C<atime>
 144
 145 L<DateTime> wrapped stat[8]
 146
 147 =item C<mtime>
 148
 149 L<DateTime> wrapped stat[9]
 150
 151 =item C<data>
 152
 153 Ref to the actual data in raw encoding.
 154
 155 =item C<href>
 156
 157 URL relative to the web base dir for download.
 158
 159 =item C<full_filedescriptor>
 160
 161 Fully qualified path to file.
 162
 163 =back
 164
 165 =head1 SEE ALSO
 166
 167 L<SL::Webdav>, L<SL::Webdav::File>
 168
 169 =head1 BUGS
 170
 171 None yet :)
 172
 173 =head1 AUTHOR
 174
 175 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 176
 177 =cut