SL/Webdav.pm

   1 package SL::Webdav;
   2
   3 use strict;
   4 use parent qw(Rose::Object);
   5
   6 use Encode qw(decode);
   7 use File::Spec;
   8 use SL::Common;
   9 use SL::Webdav::File;
  10 use SL::Webdav::Object;
  11 use SL::Webdav::VersionScheme::Serial;
  12 use SL::Webdav::VersionScheme::Timestamp;
  13
  14 use Rose::Object::MakeMethods::Generic (
  15   scalar => [ qw(type number) ],
  16   'scalar --get_set_init' => [ qw(version_scheme) ],
  17 );
  18
  19 my %type_to_path = (
  20   sales_quotation         => 'angebote',
  21   sales_order             => 'bestellungen',
  22   request_quotation       => 'anfragen',
  23   purchase_order          => 'lieferantenbestellungen',
  24   sales_delivery_order    => 'verkaufslieferscheine',
  25   purchase_delivery_order => 'einkaufslieferscheine',
  26   credit_note             => 'gutschriften',
  27   invoice                 => 'rechnungen',
  28   purchase_invoice        => 'einkaufsrechnungen',
  29   part                    => 'waren',
  30   service                 => 'dienstleistungen',
  31   assembly                => 'erzeugnisse',
  32   letter                  => 'briefe',
  33 );
  34
  35 sub get_all_files {
  36   my ($self) = @_;
  37
  38   my @objects = $self->get_all_objects;
  39   my %files_by_name;
  40
  41   for my $obj (@objects) {
  42     my $filename = join '.', grep $_, $obj->basename, $obj->extension;
  43
  44     my $file = $files_by_name{$filename} ||= SL::Webdav::File->new(filename => $filename, webdav => $self, loaded => 1);
  45     $file->add_objects($obj);
  46   }
  47
  48   return values %files_by_name;
  49 }
  50
  51 sub get_all_objects {
  52   my ($self) = @_;
  53
  54   my $path = $self->webdav_path;
  55   my @objects;
  56
  57   my $base_path = $ENV{'SCRIPT_NAME'};
  58   $base_path =~ s|[^/]+$||;
  59   if (opendir my $dir, $path) {
  60     foreach my $file (sort { lc $a cmp lc $b } map { decode("UTF-8", $_) } readdir $dir) {
  61       next if (($file eq '.') || ($file eq '..'));
  62
  63       my $fname = $file;
  64       $fname  =~ s|.*/||;
  65
  66       push @objects, SL::Webdav::Object->new(filename => $fname, webdav => $self);
  67     }
  68
  69     closedir $dir;
  70
  71     return @objects;
  72   }
  73 }
  74
  75 sub get_all_latest {
  76   my ($self) = @_;
  77
  78   my @files = $self->get_all_files;
  79   map { ($_->versions)[-1] } @files;
  80 }
  81
  82 sub _sanitized_number {
  83   my $number = $_[0]->number;
  84   $number =~ s|[/\\]|_|g;
  85   $number;
  86 }
  87
  88 sub webdav_path {
  89   my ($self) = @_;
  90
  91   die "No client set in \$::auth" unless $::auth->client;
  92   die "Need number"               unless $self->number;
  93
  94   my $type = $type_to_path{$self->type};
  95
  96   die "Unknown type"              unless $type;
  97
  98   my $path = File::Spec->catdir("webdav", $::auth->client->{id}, $type, $self->_sanitized_number);
  99
 100   if (!-d $path) {
 101     Common::mkdir_with_parents($path);
 102   }
 103
 104   return $path;
 105 }
 106
 107 sub init_version_scheme {
 108   SL::Webdav::VersionScheme::Timestamp->new;
 109 }
 110
 111 1;
 112
 113 __END__
 114
 115 =encoding utf-8
 116
 117 =head1 NAME
 118
 119 SL::Webdav - Webdav manipulation
 120
 121 =head1 SYNOPSIS
 122
 123   # get list of all documents for this record
 124   use SL::Webdav;
 125
 126   my $webdav = SL::Webdav->new(
 127     type     => 'part',
 128     number   => $number,
 129   );
 130
 131   # gives you SL::Webdav::File instances
 132   my $webdav_files = $webdav->get_all_files;
 133
 134   # gives you the objects instead
 135   my $webdav_objects = $webdav->get_all_objects;
 136
 137   # gives you only the latest objects
 138   my $webdav_objects = $webdav->get_all_latest;
 139
 140   # physical path to this dir
 141   my $path = $webdav->webdav_path;
 142
 143 =head1 DESCRIPTION
 144
 145 This module is a wrapper around the webdav storage mechanism with some simple
 146 document management functionality.
 147
 148 This is not a replacement for real document management, mostly because the
 149 underlying webdav storage is not fully under our control. It's common practice
 150 to allow people direct samba access to the webdav, so all versioning
 151 information needs to be encoded into the filename of a file, and nonsensical
 152 filenames must not break assumptions.
 153
 154 This module is intended to be used if you need to scan the folder for
 155 previously saved files and need to build a list in order to display it.
 156
 157 If you need to manipulate the versions of a file, see L<SL::Webdav::File>
 158
 159 If you need to access a file directly for download or metadata, see L<SL::Webdav::Object>
 160
 161 =head1 FUNCTIONS
 162
 163 =over 4
 164
 165 =item C<get_all_objects>
 166
 167 Returns all L<SL::Webdav::Objects> found.
 168
 169 =item C<get_all_files>
 170
 171 Returns all objects sorted into L<SL::Webdav::File>s.
 172
 173 =item C<get_all_latest>
 174
 175 Returns only the latest object of each L<SL::Webdav::File> found.
 176
 177 =item C<webdav_path>
 178
 179 Returns the physical path to this webdav object.
 180
 181 =back
 182
 183 =head1 VERSIONING SCHEME
 184
 185 You may register a versioning scheme object to handle versioning. It is
 186 expected to implement the following methods:
 187
 188 =over 4
 189
 190 =item C<separator>
 191
 192 Must return a string that will be used to separate the basename and version part of
 193 filenames when generating and parsing.
 194
 195 =item C<extract_regexp>
 196
 197 Must return a regexp that will match a versioning string at the end of a
 198 filename after the extension has been stripped off. It will be surrounded by
 199 captures.
 200
 201 =item C<cmp>
 202
 203 Must return a comparison function that will be invoked with two
 204 L<SL::Webdav::Object> instances.
 205
 206 =item C<first_version>
 207
 208 Must return a string representing the version of the first of a series of objects.
 209
 210 May return undef.
 211
 212 =item C<next_version>
 213
 214 Will be called with the latest L<SL::Webdav::Object> and must return a new version string.
 215
 216 =item C<keep_last_version>
 217
 218 Will be called with the latest L<SL::Webdav::Object>. Truish return value will
 219 cause the latest object to be overwritten instead of creating a new version.
 220
 221 =back
 222
 223 =head1 BUGS AND CAVEATS
 224
 225 =over 4
 226
 227 =item *
 228
 229 File operations are inconsistently L<File::Spec>ed.
 230
 231 =back
 232
 233 =head1 SEE ALSO
 234
 235 L<SL::Webdav::File>, L<SL::Webdav::Object>
 236
 237 =head1 AUTHOR
 238
 239 Sven Schöling E<lt>s.schoeling@linet-services.deE<gt>
 240
 241 =cut