Dialogbuchung - Buchen, Storno und Löschen protokollieren
[kivitendo-erp.git] / 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
8 use Rose::Object::MakeMethods::Generic (
9   scalar => [ qw(webdav filename loaded) ],
10   array  => [
11     qw(objects),
12     add_objects => { interface => 'push', hash_key => 'objects' },
13   ],
14 );
15
16 sub versions {
17   $_[0]->load unless $_[0]->loaded;
18   my $cmp = $_[0]->webdav->version_scheme->cmp;
19   sort { $cmp->($a, $b) } $_[0]->objects;
20 }
21
22 sub latest_version {
23   ($_[0]->versions)[-1]
24 }
25
26 sub load {
27   my ($self) = @_;
28   my @objects = $self->webdav->get_all_objects;
29   my $ref = SL::Webdav::Object->new(filename => $self->filename, webdav => $self->webdav);
30   my ($ref_basename, undef, $ref_extension) = $ref->parse_filename;
31
32   $self->objects(grep { $_->basename eq $ref_basename && $_->extension eq $ref_extension } @objects);
33   $self->loaded(1);
34 }
35
36 sub store {
37   my ($self, %params) = @_;
38
39   $self->load unless $self->loaded;
40
41   my $last = $self->latest_version;
42   my $object;
43
44   if (!$last) {
45     my $new_version  = $self->webdav->version_scheme->first_version;
46     $object = SL::Webdav::Object->new(filename => $self->filename, webdav => $self->webdav);
47
48     $self->add_objects($object);
49   } else {
50     if (!$self->webdav->version_scheme->keep_last_version($last)) {
51       $params{new_version} = 1;
52     }
53
54     if ($params{new_version}) {
55       my $new_version  = $self->webdav->version_scheme->next_version($last);
56       my $sep          = $self->webdav->version_scheme->separator;
57       my $new_filename = $last->basename . $sep . $new_version . "." . $last->extension;
58       $object = SL::Webdav::Object->new(filename => $new_filename, webdav => $self->webdav);
59
60       $self->add_objects($object);
61     } else {
62       $object = $last;
63     }
64   }
65
66   open my $fh, '>:raw', $object->full_filedescriptor or die "could not open " . $object->filename . ": $!";
67
68   $fh->print(${ $params{data} });
69
70   close $fh;
71
72   return $object;
73 }
74
75 1;
76
77 __END__
78
79 =encoding utf-8
80
81 =head1 NAME
82
83 SL::Webdav::File - Webdav file manipulation
84
85 =head1 SYNOPSIS
86
87   use SL::Webdav::File;
88
89   my $webdav_file = SL::Webdav::File->new(
90     webdav   => $webdav,  # SL::Webdav instance
91     filename => 'technical_drawing_AB28375.pdf',
92   );
93
94   # get existing versioned files
95   my @webdav_objects = $webdav_file->versions;
96
97   # store new version
98   my $data = SL::Helper::CreatePDF->create_pdf(...);
99   my $webdav_object = $webdav_file->store(data => \$data);
100
101   # force new version
102   my $webdav_object = $webdav_file->store(data => \$data, new_version => 1);
103
104 =head1 DESCRIPTION
105
106 A file in this context is the collection of all versions of a single file saved
107 into the webdav. This module provides methods to access and manipulate these
108 objects.
109
110 =head1 FUNCTIONS
111
112 =over 4
113
114 =item C<versions>
115
116 Will return all L<SL::Webdav::Object>s found in this file, sorted by version
117 according to the version scheme used.
118
119 =item C<latest_version>
120
121 Returns only the latest version object.
122
123 =item C<load>
124
125 Loads objects from disk.
126
127 =item C<store PARAMS>
128
129 Store a new version on disk. C<data> is expected to contain a reference to the
130 data to be written in raw encoding.
131
132 If param C<new_version> is set, force a new version, even if the versioning
133 scheme would keep the old one.
134
135 =back
136
137 =head1 SEE ALSO
138
139 L<SL::Webdav>, L<SL::Webdav::Object>
140
141 =head1 BUGS
142
143 None yet :)
144
145 =head1 AUTHOR
146
147 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
148
149 =cut