SL/Clipboard.pm

   1 package SL::Clipboard;
   2
   3 use strict;
   4
   5 use parent qw(Rose::Object);
   6
   7 use Rose::Object::MakeMethods::Generic (
   8   'scalar --get_set_init' => [ qw(content) ],
   9 );
  10
  11 use Carp;
  12 use List::MoreUtils qw(apply);
  13 use List::Util qw(first);
  14 use Scalar::Util qw(blessed);
  15
  16 use SL::Clipboard::RequirementSpecItem;
  17 use SL::Clipboard::RequirementSpecTextBlock;
  18
  19 sub init_content {
  20   my $value = $::auth->get_session_value('clipboard-content');
  21   return ref($value) eq 'HASH' ? $value : { entries => [] };
  22 }
  23
  24 sub copy {
  25   my ($self, $object) = @_;
  26
  27   my $copied = $self->_create_copy_of($object);
  28   push @{ $self->content->{entries} }, $copied;
  29
  30   $self->_save_content;
  31
  32   return $copied;
  33 }
  34
  35 sub get_entry {
  36   my ($self, $type) = @_;
  37
  38   $type ||= qr/./;
  39
  40   return first   { $_->type =~ $type          }
  41          reverse @{ $self->content->{entries} };
  42 }
  43
  44 sub get_entries {
  45   my ($self, $type) = @_;
  46
  47   $type ||= qr/./;
  48
  49   return grep    { $_->{type} =~ $type        }
  50          reverse @{ $self->content->{entries} };
  51 }
  52
  53 sub clear {
  54   my ($self) = @_;
  55
  56   $self->content->{entries} = [];
  57   $self->_save_content;
  58
  59   return $self;
  60 }
  61
  62 sub _log_entries {
  63   my ($self) = @_;
  64
  65   $::lxdebug->message(0, "Clipboard entries: " . scalar(@{ $self->content->{entries} }));
  66   foreach (@{ $self->content->{entries} }) {
  67     $::lxdebug->message(0, "  " . $_->type . ' ' . $_->timestamp . ' ' . $_->describe);
  68   }
  69 }
  70
  71 sub _create_copy_of {
  72   my ($self, $object) = @_;
  73
  74   croak "\$object is not a blessed reference." unless blessed($object);
  75
  76   my $type   = (split(m/::/, ref($object)))[-1];
  77   my $copied = eval { "SL::Clipboard::${type}"->new(timestamp => DateTime->now_local) };
  78
  79   croak "Class '" . ref($object) . "' not supported for copy/paste operations" if !$copied;
  80
  81   $copied->content($copied->dump($object));
  82
  83   return $copied;
  84 }
  85
  86 sub _save_content {
  87   my ($self) = @_;
  88
  89   $::auth->set_session_value('clipboard-content', $self->content);
  90
  91   return $self;
  92 }
  93
  94 1;
  95
  96 __END__
  97
  98 =pod
  99
 100 =encoding utf8
 101
 102 =head1 NAME
 103
 104 SL::Clipboard - A session-based clipboard mechanism for
 105 Rose::DB::Object instances
 106
 107 =head1 SYNOPSIS
 108
 109   # In a controller, e.g. for customers, you can react to a "copy" operation:
 110   my $customer = SL::DB::Customer->new(id => $::form->{id});
 111   SL::Clipboard->new->copy($customer);
 112
 113   # Later in a paste action:
 114   my $copied = SL::Clipboard->new->get_entry(qr/^Customer$/);
 115   if ($copied) {
 116     my $customer = $copied->to_object;
 117     $customer->save;
 118   }
 119
 120 =head1 OVERVIEW
 121
 122 The clipboard can store an unlimited number of copies of
 123 Rose::DB::Object instances. The instances are dumped into trees using
 124 L<Rose::DB::Object::Helpers/as_tree>. How much of such an object is
 125 copied depends on its type. For example, a dump of a customer object
 126 might also include the dumps of the shipping address and contact
 127 objects belonging to the customer.
 128
 129 Each clipped object is stored in the user's session along with the
 130 timestamp of the copy operation. A controller can then query the
 131 clipboard for the latest clipped object of a certain type (or more
 132 types if the situation allows insertion of different types). If such a
 133 clipped object is available it can be turned into a shiny new
 134 Rose::DB::Object instance that can be saved to the database.
 135
 136 Primary key columns will always be reset as will other columns
 137 depending on the type. For example, a copied requirement spec item
 138 will have its C<requirement_spec_id> column cleared. The controller is
 139 responsible for setting the columns before saving the object.
 140
 141 Not every Rose::DB::Object instance can be copied. For each supported
 142 type C<Type> there must be a specialized clipboard support class
 143 C<SL::Clipboard::Type>. The type's name is derived from the Rose class
 144 name: by stripping the leading C<SL::DB::>. So the clipboard support
 145 class for a requirement spec item Rose class
 146 C<SL::DB::RequirementSpecItem> would be
 147 C<SL::Clipboard::RequirementSpecItem>. These support classes must
 148 inherit from L<SL::Clipboard::Base> which offers almost a full set of
 149 support functions so that the actual specialized class has to do very
 150 little.
 151
 152 As the clipboard is session-based its contents will be lost when the
 153 session expires (either due to timeouts or to the user logging off).
 154
 155 =head1 FUNCTIONS
 156
 157 =over 4
 158
 159 =item C<clear>
 160
 161 Clears the clipboard (removes all entries).
 162
 163 =item C<copy $object>
 164
 165 Creates a dumped copy of C<$object> and stores that copy in the
 166 session. An unlimited number of copies of differing types can be
 167 made.
 168
 169 Returns the instance of the copied object, a sub-class of
 170 L<SL::Clipboard::Base>.
 171
 172 =item C<get_entries [$type]>
 173
 174 Returns an array of clipped objects whose type matches the regular
 175 expression C<$type>. If C<$type> is not given then all elements are
 176 returned.
 177
 178 The array is sorted by the copy timestamp: the first element in the
 179 array is the one most recently copied.
 180
 181 =item C<get_entry [$type]>
 182
 183 Returns the most recently clipped object whose type matches the
 184 regular expression C<$type>. If C<$type> is not given then the
 185 most recently copied object is returned.
 186
 187 If no such object exists C<undef> is returned instead.
 188
 189 =back
 190
 191 =head1 BUGS
 192
 193 Nothing here yet.
 194
 195 =head1 AUTHOR
 196
 197 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 198
 199 =cut