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