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