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