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