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