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