From c805dfd964cc6b4d24868b1835548024363e1f0f Mon Sep 17 00:00:00 2001 From: Moritz Bunkus Date: Thu, 4 Apr 2013 11:24:08 +0200 Subject: [PATCH] Clipboard: eine erste allgemeine Implementation eines Clipboard-Mechanismus-Backends MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit Enthält bereits Spezialisierungen für Pflichtenhefttextblöcke und -items (Abschnitte, Funktionsblöcke, Unterfunktionsblöcke). --- SL/Clipboard.pm | 199 ++++++++++++++++++++ SL/Clipboard/Base.pm | 223 +++++++++++++++++++++++ SL/Clipboard/RequirementSpecItem.pm | 101 ++++++++++ SL/Clipboard/RequirementSpecTextBlock.pm | 59 ++++++ 4 files changed, 582 insertions(+) create mode 100644 SL/Clipboard.pm create mode 100644 SL/Clipboard/Base.pm create mode 100644 SL/Clipboard/RequirementSpecItem.pm create mode 100644 SL/Clipboard/RequirementSpecTextBlock.pm diff --git a/SL/Clipboard.pm b/SL/Clipboard.pm new file mode 100644 index 000000000..6f30071b1 --- /dev/null +++ b/SL/Clipboard.pm @@ -0,0 +1,199 @@ +package SL::Clipboard; + +use strict; + +use parent qw(Rose::Object); + +use Rose::Object::MakeMethods::Generic ( + 'scalar --get_set_init' => [ qw(content) ], +); + +use Carp; +use List::MoreUtils qw(apply); +use List::Util qw(first); +use Scalar::Util qw(blessed); + +use SL::Clipboard::RequirementSpecItem; +use SL::Clipboard::RequirementSpecTextBlock; + +sub init_content { + my $value = $::auth->get_session_value('clipboard-content'); + return ref($value) eq 'HASH' ? $value : { entries => [] }; +} + +sub copy { + my ($self, $object) = @_; + + my $copied = $self->_create_copy_of($object); + push @{ $self->content->{entries} }, $copied; + + $self->_save_content; + + return $copied; +} + +sub get_entry { + my ($self, $type) = @_; + + $type ||= qr/./; + + return first { $_->type =~ $type } + reverse @{ $self->content->{entries} }; +} + +sub get_entries { + my ($self, $type) = @_; + + $type ||= qr/./; + + return grep { $_->{type} =~ $type } + reverse @{ $self->content->{entries} }; +} + +sub clear { + my ($self) = @_; + + $self->content->{entries} = []; + $self->_save_content; + + return $self; +} + +sub _log_entries { + my ($self) = @_; + + $::lxdebug->message(0, "Clipboard entries: " . scalar(@{ $self->content->{entries} })); + foreach (@{ $self->content->{entries} }) { + $::lxdebug->message(0, " " . $_->type . ' ' . $_->timestamp . ' ' . $_->describe); + } +} + +sub _create_copy_of { + my ($self, $object) = @_; + + croak "\$object is not a blessed reference." unless blessed($object); + + my $type = (split(m/::/, ref($object)))[-1]; + my $copied = eval { "SL::Clipboard::${type}"->new(timestamp => DateTime->now_local) }; + + croak "Class '" . ref($object) . "' not supported for copy/paste operations" if !$copied; + + $copied->content($copied->dump($object)); + + return $copied; +} + +sub _save_content { + my ($self) = @_; + + $::auth->set_session_value('clipboard-content', $self->content); + + return $self; +} + +1; + +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +SL::Clipboard - A session-based clipboard mechanism for +Rose::DB::Object instances + +=head1 SYNOPSIS + + # In a controller, e.g. for customers, you can react to a "copy" operation: + my $customer = SL::DB::Customer->new(id => $::form->{id}); + SL::Clipboard->new->copy($customer); + + # Later in a paste action: + my $copied = SL::Clipboard->new->get_entry(qr/^Customer$/); + if ($copied) { + my $customer = $copied->to_object; + $customer->save; + } + +=head1 OVERVIEW + +The clipboard can store an unlimited number of copies of +Rose::DB::Object instance. The instances are dumped into trees using +L. How much of such an object is +copied depends on its type. For example, a dump of a customer object +might also include the dumps of the shipping address and contact +objects belonging to the customer. + +Each clipped object is stored in the user's session along with the +timestamp of the copy operation. A controller can then query the +clipboard for the latest clipped object of a certain type (or more +types if the situation allows insertion of different types). If such a +clipped object is available it can be turned into a shiny new +Rose::DB::Object instance that can be saved to the database. + +Primary key columns will always be reset as will other columns +depending on the type. For example, a copied requirement spec item +will have its C column cleared. The controller is +responsible for setting the columns before saving the object. + +Not every Rose::DB::Object instance can be copied. For each supported +type C there must be a specialized clipboard support class +C. The type's name is derived from the Rose class +name: by stripping the leading C. So the clipboard support +class for a requirement spec item Rose class +C would be +C. These support classes must +inherit from L which offers almost a full set of +support functions so that the actual specialized class has to do very +litte. + +As the clipboard is session-based its contents will be lost when the +session expires (either due to timeouts or to the user logging off). + +=head1 FUNCTIONS + +=over 4 + +=item C + +Clears the clipboard (removes all entries). + +=item C + +Creates a dumped copy of C<$object> and stores that copy in the +session. An unlimited number of copies of differeing types can be +made. + +Returns the instance of the copied object, a sub-class of +L. + +=item C + +Returns an array of clipped objects whose type matches the regular +expression C<$type>. If C<$type> is not given then all elements are +returned. + +The array is sorted by the copy timestamp: the first element in the +array is the one most recently copied. + +=item C + +Returns the most recently clipped object whose type matches the +regular expression C<$type>. If C<$type> is not given then then then +most recently copied object is returned. + +If no such object exists C is returned instead. + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut diff --git a/SL/Clipboard/Base.pm b/SL/Clipboard/Base.pm new file mode 100644 index 000000000..8b7f92a64 --- /dev/null +++ b/SL/Clipboard/Base.pm @@ -0,0 +1,223 @@ +package SL::Clipboard::Base; + +use strict; + +use parent qw(Rose::Object); + +use Rose::Object::MakeMethods::Generic ( + 'scalar --get_set_init' => [ qw(content timestamp) ], +); + +use Rose::DB::Object::Helpers (); + +sub init_timestamp { die "'timestamp' property not set"; } +sub init_content { die "'content' property not set"; } + +sub type { + my ($self_or_class) = @_; + return (split m/::/, ref($self_or_class) ? ref($self_or_class) : $self_or_class)[-1]; +} + +sub reload_object { + my ($self, $object) = @_; + + return ref($object)->new(map { $_ => $object->$_ } $object->meta->primary_key)->load; +} + +sub as_tree { + my ($self, $object, %params) = @_; + + my $tree = Rose::DB::Object::Helpers::as_tree($object, %params); + $self->_fix_tree($tree, $object); + return $tree; +} + +sub to_object { + my ($self) = @_; + my $object = Rose::DB::Object::Helpers::new_from_tree("SL::DB::" . $self->type, $self->content); + + # Reset primary key columns and itime/mtime if the class supports it. + foreach ($object->meta->primary_key, 'itime', 'mtime') { + $object->$_(undef) if $object->can($_); + } + + # Let sub classes fix the objects further. + $self->_fix_object($object); + return $object; +} + +sub dump { + my ($self, $object) = @_; + return $self->as_tree($self->reload_object($object), max_depth => 1); +} + +sub describe { + die "'describe' method not overwritten by derived class"; +} + +sub _fix_object { + my ($self, $object) = @_; + # To be overwritten by child classes. +} + +sub _fix_tree { + my ($self, $tree, $object) = @_; + + # Delete primary key columns and itime/mtime if the class supports it. + foreach ($object->meta->primary_key, 'itime', 'mtime') { + delete $tree->{$_} if $object->can($_); + } +} + +1; +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +SL::Clipboard::Base - Base class for clipboard specialization classes + +=head1 SYNOPSIS + +See the synopsis of L. + +=head1 OVERVIEW + +This is a base class providing a lot of utility and +defaults. Sub-classes must overwrite at least the function +L but can overwrite others as well. + +Writing a specialized sub-class for a database type involves +overwriting one or more functions. These are: + +=over 4 + +=item * C + +Must be overwritten. Returns a human-readable description of the +content. Should only be one line. + +=item * C + +Optional. Overwrite if sub-class needs to dump more/less than the +implementation in this class dumps. + +=item * C<_fix_object> + +Optional. Overwrite if re-created Rose::DB::Object instances must be +cleaned further before they're returned to the caller. + +=item * C<_fix_tree> + +Optional. Overwrite if the tree created during a copy operation of a +Rose::DB::Object instance must be cleaned further before it's stored. + +=back + +You don't have to or should not overwrite the other functions: + +=over 4 + +=item * C + +=item * C + +=item * C + +=item * C + +=back + +Don't forget to C the specialized module here in Base! + +=head1 FUNCTIONS + +=over 4 + +=item C + +A convenience function calling L +with C<$object> and C<%params> as parameters. Returns a hash/array +reference tree of the function. + +Don't overwrite this function in sub-classes. Overwrite L +instead. + +=item C + +Returns a human-readable description of the content. This should only +be a single line without any markup. + +Sub-classes must overwrite this function. + +=item C + +Dumps the object as a hash/array tree and returns it by calling +L. The default implementation +reloads the object first by calling L. It also only +dumps the object itself, not any of the relationships, by calling +C with the parameter C 1>. + +Overwrite this in a sub-class if you need to dump more or differently +(see L for an example). + +=item C + +Reloads C<$object> from the database and returns a new instance. Can +be useful for sanitizing the object given to L before +converting into a tree. It is used by the default implementation of +L. + +=item C + +Converts the dumped representation back to an Rose::DB::Object +instance. Several columns of the newly created object are cleared by +C itself: the primary key columns (if any) and the columns +C and C (if the object has such columns). + +This function should not be overwritten by sub-classes. Instead, +functions can overwrite C<_fix_object> which can be used for sanitzing +the newly created object before handing it back to the caller. + +=item C + +Returns the actual clipped type (e.g. C). This is +derived from the actual class name of C<$self>. + +=item C<_fix_object $object> + +This function is called by L before the object is passed +back to the caller. It does not do anything in the default +implementation, but sub-classes are free to overwrite it if they need +to sanitize the object. See L for +an example. + +Its return value is ignored. + +=item C<_fix_tree $tree, $object> + +This function is called by L after dumping and before the +object is stored during a copy operation. In the default +implementation all primary key columns and the columns C and +C (if the object has such columns) are removed from the tree. +Sub-classes are free to overwrite it if they need to sanitize the +tree. See L for an example. + +C<$object> is just passed in for reference and should not be modified. + +Its return value is ignored. + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut diff --git a/SL/Clipboard/RequirementSpecItem.pm b/SL/Clipboard/RequirementSpecItem.pm new file mode 100644 index 000000000..85bd5d967 --- /dev/null +++ b/SL/Clipboard/RequirementSpecItem.pm @@ -0,0 +1,101 @@ +package SL::Clipboard::RequirementSpecItem; + +use strict; + +use parent qw(SL::Clipboard::Base); + +use List::Util qw(sum); + +use SL::Common; +use SL::Locale::String; + +sub dump { + my ($self, $object) = @_; + + return $self->as_tree(_load_children($self->reload_object($object)), exclude => sub { ref($_[0]) !~ m/::RequirementSpecItem$/ }); +} + +sub describe { + my ($self) = @_; + + my $item = $self->content; + my $num_children = @{ $item->{children} || [] }; + my $num_grandchildren = sum map { scalar(@{ $_->{children} || [] }) } @{ $item->{children} || [] }; + + if ($item->{item_type} eq 'section') { + return t8('Requirement spec section #1 "#2" with #3 function blocks and a total of #4 sub function blocks; preamble: "#5"', + $item->{fb_number}, $item->{title}, $num_children, $num_grandchildren, Common::truncate($item->{description}, strip => 'full')); + } elsif ($item->{item_type} eq 'function-block') { + return t8('Requirement spec function block #1 with #2 sub function blocks; description: "#3"', + $item->{fb_number}, $num_children, Common::truncate($item->{description}, strip => 'full')); + } else { + return t8('Requirement spec sub function block #1; description: "#2"', + $item->{fb_number}, Common::truncate($item->{description}, strip => 'full')); + } +} + +sub _load_children { + my ($object) = @_; + + _load_children($_) for @{ $object->children }; + + return $object; +} + +sub _fix_object { + my ($self, $object) = @_; + + $object->$_(undef) for qw(fb_number); + $self->_fix_object($_) for @{ $object->children || [] }; +} + +sub _fix_tree { + my ($self, $tree, $object) = @_; + + delete @{ $tree }{ qw(id itime mtime parent_id position requirement_spec_id) }; + $self->_fix_tree($_) for @{ $tree->{children} || [] }; +} + +1; +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +SL::Clipboard::RequirementSpecItem - Clipboard specialization for +SL::DB::RequirementSpecItem + +=head1 FUNCTIONS + +=over 4 + +=item C + +Returns a human-readable description depending on the copied type +(section, function block or sub function block). + +=item C + +This specialization reloads C<$object> from the database, loads all of +its children (but only the other requirement spec items, no other +relationships) and dumps it. + +=item C<_fix_object $object> + +Fixes C<$object> and all of its children by clearing certain columns +like the position or function block numbers. + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut diff --git a/SL/Clipboard/RequirementSpecTextBlock.pm b/SL/Clipboard/RequirementSpecTextBlock.pm new file mode 100644 index 000000000..53333c56a --- /dev/null +++ b/SL/Clipboard/RequirementSpecTextBlock.pm @@ -0,0 +1,59 @@ +package SL::Clipboard::RequirementSpecTextBlock; + +use strict; + +use parent qw(SL::Clipboard::Base); + +use SL::Common; +use SL::Locale::String; + +sub describe { + my ($self) = @_; + + return t8('Requirement spec text block "#1"; content: "#2"', $self->content->{title}, Common::truncate($self->content->{text}, strip => 'full')); +} + +sub _fix_object { + my ($self, $object) = @_; + + $object->$_(undef) for qw(output_position position requirement_spec_id); + + return $object; +} + +1; +__END__ + +=pod + +=encoding utf8 + +=head1 NAME + +SL::Clipboard::RequirementSpecTextBlock - Clipboard specialization for +SL::DB::RequirementSpecTextBlock + +=head1 FUNCTIONS + +=over 4 + +=item C + +Returns a human-readable description including the title and an +excerpt of its content. + +=item C<_fix_object $object> + +Fixes C<$object> by clearing certain columns like the position. + +=back + +=head1 BUGS + +Nothing here yet. + +=head1 AUTHOR + +Moritz Bunkus Em.bunkus@linet-services.deE + +=cut -- 2.20.1