SL/File.pm

   1 package SL::File;
   2
   3 use strict;
   4
   5 use parent qw(Rose::Object);
   6
   7 use SL::File::Backend;
   8 use SL::File::Object;
   9 use SL::DB::History;
  10 use SL::DB::ShopImage;
  11 use SL::DB::File;
  12 use SL::Helper::UserPreferences;
  13 use SL::Controller::Helper::ThumbnailCreator qw(file_probe_type);
  14 use SL::JSON;
  15
  16 use constant RENAME_OK          => 0;
  17 use constant RENAME_EXISTS      => 1;
  18 use constant RENAME_NOFILE      => 2;
  19 use constant RENAME_SAME        => 3;
  20 use constant RENAME_NEW_VERSION => 4;
  21
  22 sub get {
  23   my ($self, %params) = @_;
  24   die 'no id' unless $params{id};
  25   my $dbfile = SL::DB::Manager::File->get_first(query => [id => $params{id}]);
  26   die 'not found' unless $dbfile;
  27   $main::lxdebug->message(LXDebug->DEBUG2(), "object_id=".$dbfile->object_id." object_type=".$dbfile->object_type." dbfile=".$dbfile);
  28   SL::File::Object->new(db_file => $dbfile, id => $dbfile->id, loaded => 1);
  29 }
  30
  31 sub get_version_count {
  32   my ($self, %params) = @_;
  33   die "no id or dbfile" unless $params{id} || $params{dbfile};
  34   $params{dbfile} = SL::DB::Manager::File->get_first(query => [id => $params{id}]) if !$params{dbfile};
  35   die 'not found' unless $params{dbfile};
  36   my $backend = $self->_get_backend($params{dbfile}->backend);
  37   return $backend->get_version_count(%params);
  38 }
  39
  40 sub get_all {
  41   my ($self, %params) = @_;
  42
  43   my @files;
  44   return @files unless $params{object_type};
  45   return @files unless defined($params{object_id});
  46
  47   my @query = (
  48     object_id   => $params{object_id},
  49     object_type => $params{object_type}
  50   );
  51   push @query, (file_name => $params{file_name}) if $params{file_name};
  52   push @query, (file_type => $params{file_type}) if $params{file_type};
  53   push @query, (mime_type => $params{mime_type}) if $params{mime_type};
  54   push @query, (source    => $params{source})    if $params{source};
  55
  56   my $sortby = $params{sort_by} || 'itime DESC,file_name ASC';
  57
  58   @files = @{ SL::DB::Manager::File->get_all(query => [@query], sort_by => $sortby) };
  59   map { SL::File::Object->new(db_file => $_, id => $_->id, loaded => 1) } @files;
  60 }
  61
  62 sub get_all_versions {
  63   my ($self, %params) = @_;
  64   my @versionobjs;
  65   my @fileobjs = $self->get_all(%params);
  66   if ( $params{dbfile} ) {
  67     push @fileobjs, SL::File::Object->new(dbfile => $params{db_file}, id => $params{dbfile}->id, loaded => 1);
  68   } else {
  69     @fileobjs = $self->get_all(%params);
  70   }
  71   foreach my $fileobj (@fileobjs) {
  72     $main::lxdebug->message(LXDebug->DEBUG2(), "obj=" . $fileobj . " id=" . $fileobj->id." versions=".$fileobj->version_count);
  73     my $maxversion = $fileobj->version_count;
  74     $fileobj->version($maxversion);
  75     push @versionobjs, $fileobj;
  76     if ($maxversion > 1) {
  77       for my $version (2..$maxversion) {
  78         $main::lxdebug->message(LXDebug->DEBUG2(), "clone for version=".($maxversion-$version+1));
  79         eval {
  80           my $clone = $fileobj->clone;
  81           $clone->version($maxversion-$version+1);
  82           $clone->newest(0);
  83           $main::lxdebug->message(LXDebug->DEBUG2(), "clone version=".$clone->version." mtime=". $clone->mtime);
  84           push @versionobjs, $clone;
  85           1;
  86         } or do {$::lxdebug->message(LXDebug::WARN(), "clone for version=".($maxversion-$version+1) . "failed: " . $@)};
  87       }
  88     }
  89   }
  90   return @versionobjs;
  91 }
  92
  93 sub get_all_count {
  94   my ($self, %params) = @_;
  95   return 0 unless $params{object_type};
  96
  97   my @query = (
  98     object_id   => $params{object_id},
  99     object_type => $params{object_type}
 100   );
 101   push @query, (file_name => $params{file_name}) if $params{file_name};
 102   push @query, (file_type => $params{file_type}) if $params{file_type};
 103   push @query, (mime_type => $params{mime_type}) if $params{mime_type};
 104   push @query, (source    => $params{source})    if $params{source};
 105
 106   my $cnt = SL::DB::Manager::File->get_all_count(query => [@query]);
 107   return $cnt;
 108 }
 109
 110 sub delete_all {
 111   my ($self, %params) = @_;
 112   return 0 unless defined($params{object_id}) || $params{object_type};
 113   my $files = SL::DB::Manager::File->get_all(
 114     query => [
 115       object_id   => $params{object_id},
 116       object_type => $params{object_type}
 117     ]
 118   );
 119   foreach my $file (@{$files}) {
 120     $params{dbfile} = $file;
 121     $self->delete(%params);
 122   }
 123 }
 124
 125 sub delete {
 126   my ($self, %params) = @_;
 127   die "no id or dbfile in delete" unless $params{id} || $params{dbfile};
 128   my $rc = 0;
 129   eval {
 130     $rc = SL::DB->client->with_transaction(\&_delete, $self, %params);
 131     1;
 132   } or do { die $@ };
 133   return $rc;
 134 }
 135
 136 sub _delete {
 137   my ($self, %params) = @_;
 138   $params{dbfile} = SL::DB::Manager::File->get_first(query => [id => $params{id}]) if !$params{dbfile};
 139
 140   my $backend = $self->_get_backend($params{dbfile}->backend);
 141   if ( $params{dbfile}->file_type eq 'document' && $params{dbfile}->source ne 'created')
 142   {
 143     ## must unimport
 144     my $hist = SL::DB::Manager::History->get_first(
 145       where => [
 146         addition  => 'IMPORT',
 147         trans_id  => $params{dbfile}->object_id,
 148         what_done => $params{dbfile}->id
 149       ]
 150     );
 151
 152     if ($hist) {
 153       if (!$main::auth->assert('import_ar | import_ap', 1)) {
 154         die 'no permission to unimport';
 155       }
 156       my $file = $backend->get_filepath(dbfile => $params{dbfile});
 157       $main::lxdebug->message(LXDebug->DEBUG2(), "del file=" . $file . " to=" . $hist->snumbers);
 158       File::Copy::copy($file, $hist->snumbers) if $file;
 159       $hist->addition('UNIMPORT');
 160       $hist->save;
 161     }
 162   }
 163   if ($backend->delete(%params)) {
 164     my $do_delete = 0;
 165     if ( $params{last} || $params{version} || $params{all_but_notlast} ) {
 166       if ( $backend->get_version_count(%params) > 0 ) {
 167         $params{dbfile}->mtime(DateTime->now_local);
 168         $params{dbfile}->save;
 169       } else {
 170         $do_delete = 1;
 171       }
 172     } else {
 173       $do_delete = 1;
 174     }
 175     $params{dbfile}->delete if $do_delete;
 176     return 1;
 177   }
 178   return 0;
 179 }
 180
 181 sub save {
 182   my ($self, %params) = @_;
 183
 184   my $obj;
 185   eval {
 186     $obj = SL::DB->client->with_transaction(\&_save, $self, %params);
 187     1;
 188   } or do { die $@ };
 189   return $obj;
 190 }
 191
 192 sub _save {
 193   my ($self, %params) = @_;
 194   my $file = $params{dbfile};
 195   my $exists = 0;
 196
 197   if ($params{id}) {
 198     $file = SL::DB::File->new(id => $params{id})->load;
 199     die 'dbfile not exists'     unless $file;
 200   } elsif (!$file) {
 201   $main::lxdebug->message(LXDebug->DEBUG2(), "obj_id=" .$params{object_id});
 202     die 'no object type set'    unless $params{object_type};
 203     die 'no object id set'      unless defined($params{object_id});
 204
 205     $exists = $self->get_all_count(%params);
 206     die 'filename still exist' if $exists && $params{fail_if_exists};
 207     if ($exists) {
 208       my ($obj1) = $self->get_all(%params);
 209       $file = $obj1->db_file;
 210     } else {
 211       $file = SL::DB::File->new();
 212       $file->assign_attributes(
 213         object_id      => $params{object_id},
 214         object_type    => $params{object_type},
 215         source         => $params{source},
 216         file_type      => $params{file_type},
 217         file_name      => $params{file_name},
 218         mime_type      => $params{mime_type},
 219         title          => $params{title},
 220         description    => $params{description},
 221       );
 222       $file->itime($params{mtime})    if $params{mtime};
 223       $params{itime} = $params{mtime} if $params{mtime};
 224     }
 225   } else {
 226     $exists = 1;
 227   }
 228   if ($exists) {
 229     #change attr on existing file
 230     $file->file_name  ($params{file_name})   if $params{file_name};
 231     $file->mime_type  ($params{mime_type})   if $params{mime_type};
 232     $file->title      ($params{title})       if $params{title};
 233     $file->description($params{description}) if $params{description};
 234   }
 235   if ( !$file->backend ) {
 236     $file->backend($self->_get_backend_by_file_type($file));
 237     # load itime for new file
 238     $file->save->load;
 239   }
 240
 241   $file->mtime(DateTime->now_local) unless $params{mtime};
 242   $file->mtime($params{mtime}     ) if     $params{mtime};
 243
 244   my $backend = $self->_get_backend($file->backend);
 245   $params{dbfile} = $file;
 246   $backend->save(%params);
 247
 248   $file->save;
 249   #ShopImage
 250   if($file->object_type eq "shop_image"){
 251     my $image_content = $params{file_contents};
 252     my $thumbnail = file_probe_type($image_content);
 253     my $shopimage = SL::DB::ShopImage->new();
 254     $shopimage->assign_attributes(
 255                                   file_id                => $file->id,
 256                                   thumbnail_content      => $thumbnail->{thumbnail_img_content},
 257                                   org_file_height        => $thumbnail->{file_image_height},
 258                                   org_file_width         => $thumbnail->{file_image_width},
 259                                   thumbnail_content_type => $thumbnail->{thumbnail_img_content_type},
 260                                   object_id              => $file->object_id,
 261                                  );
 262     $shopimage->save;
 263   }
 264   if ($params{file_type} eq 'document' && $params{source} ne 'created') {
 265     SL::DB::History->new(
 266       addition    => 'IMPORT',
 267       trans_id    => $params{object_id},
 268       snumbers    => $params{file_path},
 269       employee_id => SL::DB::Manager::Employee->current->id,
 270       what_done   => $params{dbfile}->id
 271     )->save();
 272   }
 273   return $params{obj} if $params{dbfile} && $params{obj};
 274   return SL::File::Object->new(db_file => $file, id => $file->id, loaded => 1);
 275 }
 276
 277 sub rename {
 278   my ($self, %params) = @_;
 279   return RENAME_NOFILE unless $params{id} || $params{dbfile};
 280   my $file = $params{dbfile};
 281   $file = SL::DB::Manager::File->get_first(query => [id => $params{id}]) if !$file;
 282   return RENAME_NOFILE unless $file;
 283
 284   $main::lxdebug->message(LXDebug->DEBUG2(), "rename id=" . $file->id . " to=" . $params{to});
 285   if ($params{to}) {
 286     return RENAME_SAME   if $params{to} eq $file->file_name;
 287     return RENAME_EXISTS if $self->get_all_count( object_id     => $file->object_id,
 288                                                   object_type   => $file->object_type,
 289                                                   mime_type     => $file->mime_type,
 290                                                   source        => $file->source,
 291                                                   file_type     => $file->file_type,
 292                                                   file_name     => $params{to}
 293                                                 ) > 0;
 294
 295     my $backend = $self->_get_backend($file->backend);
 296     $backend->rename(dbfile => $file) if $backend;
 297     $file->file_name($params{to});
 298     $file->save;
 299   }
 300   return RENAME_OK;
 301 }
 302
 303 sub get_backend_class {
 304   my ($self, $backendname) = @_;
 305   die "no backend name set" unless $backendname;
 306   $self->_get_backend($backendname);
 307 }
 308
 309 sub get_other_sources {
 310   my ($self) = @_;
 311   my $pref = SL::Helper::UserPreferences->new(namespace => 'file_sources');
 312   $pref->login("#default#");
 313   my @sources;
 314   foreach my $tuple (@{ $pref->get_all() }) {
 315     my %lkeys  = %{ SL::JSON::from_json($tuple->{value}) };
 316     my $source = {
 317       'name'        => $tuple->{key},
 318       'description' => $lkeys{desc},
 319       'directory'   => $lkeys{dir}
 320     };
 321     push @sources, $source;
 322   }
 323   return @sources;
 324 }
 325
 326 sub sync_from_backend {
 327   my ($self, %params) = @_;
 328   return unless $params{file_type};
 329   my $file = SL::DB::File->new;
 330   $file->file_type($params{file_type});
 331   my $backend = $self->_get_backend($self->_get_backend_by_file_type($file));
 332   return unless $backend;
 333   $backend->sync_from_backend(%params);
 334 }
 335
 336 #
 337 # internal
 338 #
 339 sub _get_backend {
 340   my ($self, $backend_name) = @_;
 341   my $class = 'SL::File::Backend::' . $backend_name;
 342   my $obj   = undef;
 343   die $::locale->text('no backend enabled') if $backend_name eq 'None';
 344   eval {
 345     eval "require $class";
 346     $obj = $class->new;
 347     die $::locale->text('backend "#1" not enabled',$backend_name) unless $obj->enabled;
 348     1;
 349   } or do {
 350     if ( $obj ) {
 351       die $@;
 352     } else {
 353       die $::locale->text('backend "#1" not found',$backend_name);
 354     }
 355   };
 356   return $obj;
 357 }
 358
 359 sub _get_backend_by_file_type {
 360   my ($self, $dbfile) = @_;
 361
 362   $main::lxdebug->message(LXDebug->DEBUG2(), "_get_backend_by_file_type=" .$dbfile." type=".$dbfile->file_type);
 363   return "Filesystem" unless $dbfile;
 364   return $::instance_conf->get_doc_storage_for_documents   if $dbfile->file_type eq 'document';
 365   return $::instance_conf->get_doc_storage_for_attachments if $dbfile->file_type eq 'attachment';
 366   return $::instance_conf->get_doc_storage_for_images      if $dbfile->file_type eq 'image';
 367   return "Filesystem";
 368 }
 369
 370 1;
 371
 372 __END__
 373
 374 =pod
 375
 376 =encoding utf8
 377
 378 =head1 NAME
 379
 380 SL::File - The intermediate Layer for handling files
 381
 382 =head1 SYNOPSIS
 383
 384   # In a controller or helper ( see SL::Controller::File or SL::Helper::File )
 385   # you can create, remove, delete etc. a file in a backend independent way
 386
 387   my $file  = SL::File->save(
 388                      object_id     => $self->object_id,
 389                      object_type   => $self->object_type,
 390                      mime_type     => 'application/pdf',
 391                      file_type     => 'documents',
 392                      file_contents => 'this is no pdf');
 393
 394   my $file1  = SL::File->get(id => $id);
 395   SL::File->delete(id => $id);
 396   SL::File->delete(dbfile => $file1);
 397   SL::File->delete_all(object_id   => $object_id,
 398                        object_type => $object_type,
 399                        file_type   => $filetype      # may be optional
 400                       );
 401   SL::File->rename(id => $id,to => $newname);
 402   my $files1 = SL::File->get_all(object_id   => $object_id,
 403                                  object_type => $object_type,
 404                                  file_type   => 'images',  # may be optional
 405                                  source      => 'uploaded' # may be optional
 406                                 );
 407
 408   # Alternativelly some operation can be done with the filemangement object wrapper
 409   # and additional oparations see L<SL::File::Object>
 410
 411 =head1 OVERVIEW
 412
 413 The Filemanagemt can handle files in a storage independent way. Internal the File
 414 use the configured storage backend for the type of file.
 415 These backends must be configured in L<SL::Controller::ClientConfig> or an extra database table.
 416
 417 There are three types of files:
 418
 419 =over 2
 420
 421 =item - documents,
 422
 423 which can be generated files (for sales), scanned files or uploaded files (for purchase) for an ERP-object.
 424 They can exist in different versions. The versioning is handled implicit. All versions of a file may be
 425 deleted by the user if she/he is allowed to do this.
 426
 427 =item - attachments,
 428
 429 which have additional information for an ERP-objects. They are uploadable. If a filename still exists
 430 on a ERP-Object the new uploaded file is a new version of this or it must be renamed by user.
 431
 432 There are generic attachments for a specific document group (like sales_invoices). This attachments can be
 433 combinide/merged with the document-file in the time of printing.
 434 Today only PDF-Attachmnets can be merged with the generated document-PDF.
 435
 436 =item - images,
 437
 438 they are like attachments, but they may be have thumbnails for displaying.
 439 So the must have an image format like png,jpg. The versioning is like attachments
 440
 441 =back
 442
 443 For each type of files the backend can configured in L<SL::Controller::ClientConfig>.
 444
 445 The files have also the parameter C<Source>:
 446
 447 =over 2
 448
 449 =item - created, generated by LaTeX
 450
 451 =item - uploaded
 452
 453 =item - scanner, import from scanner
 454
 455 ( or scanner1, scanner2 if there are different scanner, be configurable via UserPreferences )
 456
 457 =item - email, received by email and imported by hand or automatic.
 458
 459 =back
 460
 461 The files from source 'scanner' or 'email' are not allowed to delete else they must be send back to the sources.
 462 This means they are moved back into the correspondent source directories.
 463
 464 The scanner and email import must be configured  via Table UserPreferences:
 465
 466 =begin text
 467
 468  id |  login  |  namespace   | version |   key    |                        value
 469 ----+---------+--------------+---------+----------+------------------------------------------------------
 470   1 | default | file_sources | 0.00000 | scanner1 | {"dir":"/var/tmp/scanner1","desc":"Scanner Einkauf" }
 471   2 | default | file_sources | 0.00000 | emails   | {"dir":"/var/tmp/emails"  ,"desc":"Empfangene Mails"}
 472
 473 =end text
 474
 475 .
 476
 477 The Fileinformation is stored in the table L<SL::DB::File> for saving the information.
 478 The modul and object_id describe the link to the object.
 479
 480 The interface SL::File:Object encapsulate SL::DB:File, see L<SL::DB::Object>
 481
 482 The storage backends are extra classes which depends from L<SL::File::Backend>.
 483 So additional backend classes can be added.
 484
 485 The implementation of versioning is done in the different backends.
 486
 487 =head1 METHODS
 488
 489 =over 4
 490
 491 =item C<save>
 492
 493 Creates a new SL::DB:File object or save an existing object for a specific backend depends of the C<file_type>
 494 and config, like
 495
 496 =begin text
 497
 498           SL::File->save(
 499                          object_id    => $self->object_id,
 500                          object_type  => $self->object_type,
 501                          content_type => 'application/pdf'
 502                         );
 503
 504 =end text
 505
 506 .
 507
 508 The file data is stored in the backend. If the file_type is "document" and the source is not "created" the file is imported,
 509 so in the history the import is documented also as a hint to can unimport the file later.
 510
 511 Available C<PARAMS>:
 512
 513 =over 4
 514
 515 =item C<id>
 516
 517 The id of SL::DB::File for an existing file
 518
 519 =item C<object_id>
 520
 521 The Id of the ERP-object for a new file.
 522
 523 =item C<object_type>
 524
 525 The Type of the ERP-object like "sales_quotation" for a new file. A clear mapping to the class/model exists in the controller.
 526
 527 =item C<file_type>
 528
 529 The type may be "documents", "attachments" or "images" for a new file.
 530
 531 =item C<source>
 532
 533 The type may be "created", "uploaded" or email sources or scanner sources for a new file.
 534
 535 =item C<file_name>
 536
 537 The file_name of the file for a new file. This name is used in the WebGUI and as name for download.
 538
 539 =item C<mime_type>
 540
 541 The mime_type of a new file. This is used for downloading or for email attachments.
 542
 543 =item C<description> or C<title>
 544
 545 The description or title of a new file. This must be discussed if this attribute is needed.
 546
 547 =back
 548
 549 =item C<delete PARAMS>
 550
 551 The file data is deleted in the backend. If the file comes from source 'scanner' or 'email'
 552 they moved back to the source folders. This is documented in the history.
 553
 554 Available C<PARAMS>:
 555
 556 =over 4
 557
 558 =item C<id>
 559
 560 The id of SL::DB::File
 561
 562 =item C<dbfile>
 563
 564 As alternative if the SL::DB::File as object is available.
 565
 566 =back
 567
 568 =item C<delete_all PARAMS>
 569
 570 All file data of an ERP-object is deleted in the backend.
 571
 572 =over 4
 573
 574 =item C<object_id>
 575
 576 The Id of the ERP-object.
 577
 578 =item C<object_type>
 579
 580 The Type of the ERP-object like "sales_quotation". A clear mapping to the class/model exists in the controller.
 581
 582 =back
 583
 584 =item C<rename PARAMS>
 585
 586 The Filename of the file is changed
 587
 588 Available C<PARAMS>:
 589
 590 =over 4
 591
 592 =item C<id>
 593
 594 The id of SL::DB::File
 595
 596 =item C<to>
 597
 598 The new filename
 599
 600 =back
 601
 602 =item C<get PARAMS>
 603
 604 The actual file object is retrieved. The id of the object is needed.
 605
 606 Available C<PARAMS>:
 607
 608 =over 4
 609
 610 =item C<id>
 611
 612 The id of SL::DB::File
 613
 614 =back
 615
 616 =item C<get_all PARAMS>
 617
 618 All last versions of file data objects which are related to an ERP-Document,Part,Customer,Vendor,... are retrieved.
 619
 620 Available C<PARAMS>:
 621
 622 =over 4
 623
 624 =item C<object_id>
 625
 626 The Id of the ERP-object.
 627
 628 =item C<object_type>
 629
 630 The Type of the ERP-object like "sales_quotation". A clear mapping to the class/model exists in the controller.
 631
 632 =item C<file_type>
 633
 634 The type may be "documents", "attachments" or "images". This parameter is optional.
 635
 636 =item C<file_name>
 637
 638 The name of the file . This parameter is optional.
 639
 640 =item C<mime_type>
 641
 642 The MIME type of the file . This parameter is optional.
 643
 644 =item C<source>
 645
 646 The type may be "created", "uploaded" or email sources or scanner soureces. This parameter is optional.
 647
 648 =item C<sort_by>
 649
 650 An optional parameter in which sorting the files are retrieved. Default is decrementing itime and ascending filename
 651
 652 =back
 653
 654 =item C<get_all_versions PARAMS>
 655
 656 All versions of file data objects which are related to an ERP-Document,Part,Customer,Vendor,... are retrieved.
 657 If only the versions of one file are wanted, additional parameter like file_name must be set.
 658 If the param C<dbfile> set, only the versions of this file are returned.
 659
 660 Available C<PARAMS> ar the same as L<get_all>
 661
 662
 663
 664 =item C<get_all_count PARAMS>
 665
 666 The count of available files is returned.
 667 Available C<PARAMS> ar the same as L<get_all>
 668
 669
 670 =item C<get_content PARAMS>
 671
 672 The data of a file can retrieved. A reference to the data is returned.
 673
 674 Available C<PARAMS>:
 675
 676 =over 4
 677
 678 =item C<id>
 679
 680 The id of SL::DB::File
 681
 682 =item C<dbfile>
 683
 684 If no Id exists the object SL::DB::File as param.
 685
 686 =back
 687
 688 =item C<get_file_path PARAMS>
 689
 690 Sometimes it is more useful to have a path to the file not the contents. If the backend has not stored the content as file
 691 it is in the responsibility of the backend to create a tempory session file.
 692
 693 Available C<PARAMS>:
 694
 695 =over 4
 696
 697 =item C<id>
 698
 699 The id of SL::DB::File
 700
 701 =item C<dbfile>
 702
 703 If no Id exists the object SL::DB::File as param.
 704
 705 =back
 706
 707 =item C<get_other_sources>
 708
 709 A helpful method to get the sources for scanner and email from UserPreferences. This method is need from SL::Controller::File
 710
 711 =item C<sync_from_backend>
 712
 713 For Backends which may be changed outside of kivitendo a synchronization of the database is done.
 714 This sync must be triggered by a periodical task.
 715
 716 Needed C<PARAMS>:
 717
 718 =over 4
 719
 720 =item C<file_type>
 721
 722 The synchronization is done file_type by file_type.
 723
 724 =back
 725
 726 =back
 727
 728 =head1 AUTHOR
 729
 730 Martin Helmling E<lt>martin.helmling@opendynamic.deE<gt>
 731
 732 =cut