ca: escape script in form
[kivitendo-erp.git] / 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