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