Dogcows Code - chaz/p5-File-KDBX/blob - lib/File/KDBX/Object.pm

   1 package File::KDBX::Object;
   2 # ABSTRACT: A KDBX database object
   3
   4 use warnings;
   5 use strict;
   6
   7 use Devel::GlobalDestruction;
   8 use File::KDBX::Error;
   9 use File::KDBX::Util qw(:uuid);
  10 use Hash::Util::FieldHash qw(fieldhashes);
  11 use List::Util qw(first);
  12 use Ref::Util qw(is_arrayref is_plain_arrayref is_plain_hashref is_ref);
  13 use Scalar::Util qw(blessed weaken);
  14 use namespace::clean;
  15
  16 our $VERSION = '999.999'; # VERSION
  17
  18 fieldhashes \my (%KDBX, %PARENT, %TXNS, %REFS, %SIGNALS);
  19
  20 =method new
  21
  22     $object = File::KDBX::Object->new;
  23     $object = File::KDBX::Object->new(%attributes);
  24     $object = File::KDBX::Object->new(\%data);
  25     $object = File::KDBX::Object->new(\%data, $kdbx);
  26
  27 Construct a new KDBX object.
  28
  29 There is a subtlety to take note of. There is a significant difference between:
  30
  31     File::KDBX::Entry->new(username => 'iambatman');
  32
  33 and:
  34
  35     File::KDBX::Entry->new({username => 'iambatman'}); # WRONG
  36
  37 In the first, an empty object is first created and then initialized with whatever I<attributes> are given. In
  38 the second, a hashref is blessed and essentially becomes the object. The significance is that the hashref
  39 key-value pairs will remain as-is so the structure is expected to adhere to the shape of a raw B<Object>
  40 (which varies based on the type of object), whereas with the first the attributes will set the structure in
  41 the correct way (just like using the object accessors / getters / setters).
  42
  43 The second example isn't I<generally> wrong -- this type of construction is supported for a reason, to allow
  44 for working with KDBX objects at a low level -- but it is wrong in this specific case only because
  45 C<< {username => $str} >> isn't a valid raw KDBX entry object. The L</username> attribute is really a proxy
  46 for the C<UserName> string, so the equivalent raw entry object should be
  47 C<< {strings => {UserName => {value => $str}}} >>. These are roughly equivalent:
  48
  49     File::KDBX::Entry->new(username => 'iambatman');
  50     File::KDBX::Entry->new({strings => {UserName => {value => 'iambatman'}}});
  51
  52 If this explanation went over your head, that's fine. Just stick with the attributes since they are typically
  53 easier to use correctly and provide the most convenience. If in the future you think of some kind of KDBX
  54 object manipulation you want to do that isn't supported by the accessors and methods, just know you I<can>
  55 access an object's data directly.
  56
  57 =cut
  58
  59 sub new {
  60     my $class = shift;
  61
  62     # copy constructor
  63     return $_[0]->clone if @_ == 1 && blessed $_[0] && $_[0]->isa($class);
  64
  65     my $data;
  66     $data = shift if is_plain_hashref($_[0]);
  67
  68     my $kdbx;
  69     $kdbx = shift if @_ % 2 == 1;
  70
  71     my %args = @_;
  72     $args{kdbx} //= $kdbx if defined $kdbx;
  73
  74     my $self = bless $data // {}, $class;
  75     $self->init(%args);
  76     $self->_set_nonlazy_attributes if !$data;
  77     return $self;
  78 }
  79
  80 sub _set_nonlazy_attributes { die 'Not implemented' }
  81
  82 =method init
  83
  84     $object = $object->init(%attributes);
  85
  86 Called by the constructor to set attributes. You normally should not call this.
  87
  88 =cut
  89
  90 sub init {
  91     my $self = shift;
  92     my %args = @_;
  93
  94     while (my ($key, $val) = each %args) {
  95         if (my $method = $self->can($key)) {
  96             $self->$method($val);
  97         }
  98     }
  99
 100     return $self;
 101 }
 102
 103 =method wrap
 104
 105     $object = File::KDBX::Object->wrap($object);
 106
 107 Ensure that a KDBX object is blessed.
 108
 109 =cut
 110
 111 sub wrap {
 112     my $class   = shift;
 113     my $object  = shift;
 114     return $object if blessed $object && $object->isa($class);
 115     return $class->new(@_, @$object) if is_arrayref($object);
 116     return $class->new($object, @_);
 117 }
 118
 119 =method label
 120
 121     $label = $object->label;
 122     $object->label($label);
 123
 124 Get or set the object's label, a text string that can act as a non-unique identifier. For an entry, the label
 125 is its title string. For a group, the label is its name.
 126
 127 =cut
 128
 129 sub label { die 'Not implemented' }
 130
 131 =method clone
 132
 133     $object_copy = $object->clone;
 134     $object_copy = File::KDBX::Object->new($object);
 135
 136 Make a clone of an object. By default the clone is indeed an exact copy that is associated with the same
 137 database but not actually included in the object tree (i.e. it has no parent). Some options are allowed to
 138 get different effects:
 139
 140 =for :list
 141 * C<new_uuid> - If set, generate a new UUID for the copy (default: false)
 142 * C<parent> - If set, add the copy to the same parent group, if any (default: false)
 143 * C<relabel> - If set, append " - Copy" to the object's title or name (default: false)
 144 * C<entries> - If set, copy child entries, if any (default: true)
 145 * C<groups> - If set, copy child groups, if any (default: true)
 146 * C<history> - If set, copy entry history, if any (default: true)
 147 * C<reference_password> - Toggle whether or not cloned entry's Password string should be set as a field
 148     reference to the original entry's Password string (default: false)
 149 * C<reference_username> - Toggle whether or not cloned entry's UserName string should be set as a field
 150     reference to the original entry's UserName string (default: false)
 151
 152 =cut
 153
 154 my %CLONE = (entries => 1, groups => 1, history => 1);
 155 sub clone {
 156     my $self = shift;
 157     my %args = @_;
 158
 159     local $CLONE{new_uuid}              = $args{new_uuid} // $args{parent} // 0;
 160     local $CLONE{entries}               = $args{entries}  // 1;
 161     local $CLONE{groups}                = $args{groups}   // 1;
 162     local $CLONE{history}               = $args{history}  // 1;
 163     local $CLONE{reference_password}    = $args{reference_password} // 0;
 164     local $CLONE{reference_username}    = $args{reference_username} // 0;
 165
 166     require Storable;
 167     my $copy = Storable::dclone($self);
 168
 169     if ($args{relabel} and my $label = $self->label) {
 170         $copy->label("$label - Copy");
 171     }
 172     if ($args{parent} and my $parent = $self->parent) {
 173         $parent->add_object($copy);
 174     }
 175
 176     return $copy;
 177 }
 178
 179 sub STORABLE_freeze {
 180     my $self    = shift;
 181     my $cloning = shift;
 182
 183     my $copy = {%$self};
 184     delete $copy->{entries} if !$CLONE{entries};
 185     delete $copy->{groups}  if !$CLONE{groups};
 186     delete $copy->{history} if !$CLONE{history};
 187
 188     return ($cloning ? Hash::Util::FieldHash::id($self) : ''), $copy;
 189 }
 190
 191 sub STORABLE_thaw {
 192     my $self    = shift;
 193     my $cloning = shift;
 194     my $addr    = shift;
 195     my $copy    = shift;
 196
 197     @$self{keys %$copy} = values %$copy;
 198
 199     if ($cloning) {
 200         my $kdbx = $KDBX{$addr};
 201         $self->kdbx($kdbx) if $kdbx;
 202     }
 203
 204     if (defined $self->{uuid}) {
 205         if (($CLONE{reference_password} || $CLONE{reference_username}) && $self->can('strings')) {
 206             my $uuid = format_uuid($self->{uuid});
 207             my $clone_obj = do {
 208                 local $CLONE{new_uuid}              = 0;
 209                 local $CLONE{entries}               = 1;
 210                 local $CLONE{groups}                = 1;
 211                 local $CLONE{history}               = 1;
 212                 local $CLONE{reference_password}    = 0;
 213                 local $CLONE{reference_username}    = 0;
 214                 # Clone only the entry's data and manually bless to avoid infinite recursion.
 215                 bless Storable::dclone({%$copy}), 'File::KDBX::Entry';
 216             };
 217             my $txn = $self->begin_work(snapshot => $clone_obj);
 218             if ($CLONE{reference_password}) {
 219                 $self->password("{REF:P\@I:$uuid}");
 220             }
 221             if ($CLONE{reference_username}) {
 222                 $self->username("{REF:U\@I:$uuid}");
 223             }
 224             $txn->commit;
 225         }
 226         $self->uuid(generate_uuid) if $CLONE{new_uuid};
 227     }
 228
 229     # Dualvars aren't cloned as dualvars, so dualify the icon.
 230     $self->icon_id($self->{icon_id}) if defined $self->{icon_id};
 231 }
 232
 233 =attr kdbx
 234
 235     $kdbx = $object->kdbx;
 236     $object->kdbx($kdbx);
 237
 238 Get or set the L<File::KDBX> instance associated with this object.
 239
 240 =cut
 241
 242 sub kdbx {
 243     my $self = shift;
 244     $self = $self->new if !ref $self;
 245     if (@_) {
 246         if (my $kdbx = shift) {
 247             $KDBX{$self} = $kdbx;
 248             weaken $KDBX{$self};
 249         }
 250         else {
 251             delete $KDBX{$self};
 252         }
 253     }
 254     $KDBX{$self} or throw 'Object is disassociated from a KDBX database', object => $self;
 255 }
 256
 257 =method id
 258
 259     $string_uuid = $object->id;
 260     $string_uuid = $object->id($delimiter);
 261
 262 Get the unique identifier for this object as a B<formatted> UUID string, typically for display purposes. You
 263 could use this to compare with other identifiers formatted with the same delimiter, but it is more efficient
 264 to use the raw UUID for that purpose (see L</uuid>).
 265
 266 A delimiter can optionally be provided to break up the UUID string visually. See
 267 L<File::KDBX::Util/format_uuid>.
 268
 269 =cut
 270
 271 sub id { format_uuid(shift->uuid, @_) }
 272
 273 =method group
 274
 275 =method parent
 276
 277     $group = $object->group;
 278     # OR equivalently
 279     $group = $object->parent;
 280
 281 Get the parent group to which an object belongs or C<undef> if it belongs to no group.
 282
 283 =cut
 284
 285 sub group {
 286     my $self = shift;
 287     my $id   = Hash::Util::FieldHash::id($self);
 288     if (my $group = $PARENT{$self}) {
 289         my $method = $self->_parent_container;
 290         return $group if first { $id == Hash::Util::FieldHash::id($_) } @{$group->$method};
 291         delete $PARENT{$self};
 292     }
 293     # always get lineage from root to leaf because the other way requires parent, so it would be recursive
 294     my $lineage = $self->kdbx->_trace_lineage($self) or return;
 295     my $group = pop @$lineage or return;
 296     $PARENT{$self} = $group; weaken $PARENT{$self};
 297     return $group;
 298 }
 299
 300 sub parent { shift->group(@_) }
 301
 302 sub _set_group {
 303     my $self = shift;
 304     if (my $parent = shift) {
 305         $PARENT{$self} = $parent;
 306         weaken $PARENT{$self};
 307     }
 308     else {
 309         delete $PARENT{$self};
 310     }
 311     return $self;
 312 }
 313
 314 ### Name of the parent attribute expected to contain the object
 315 sub _parent_container { die 'Not implemented' }
 316
 317 =method lineage
 318
 319     \@lineage = $object->lineage;
 320     \@lineage = $object->lineage($base_group);
 321
 322 Get the direct line of ancestors from C<$base_group> (default: the root group) to an object. The lineage
 323 includes the base group but I<not> the target object. Returns C<undef> if the target is not in the database
 324 structure. Returns an empty arrayref is the object itself is a root group.
 325
 326 =cut
 327
 328 sub lineage {
 329     my $self = shift;
 330     my $base = shift;
 331
 332     my $base_addr = $base ? Hash::Util::FieldHash::id($base) : 0;
 333
 334     # try leaf to root
 335     my @path;
 336     my $o = $self;
 337     while ($o = $o->parent) {
 338         unshift @path, $o;
 339         last if $base_addr == Hash::Util::FieldHash::id($o);
 340     }
 341     return \@path if @path && ($base_addr == Hash::Util::FieldHash::id($path[0]) || $path[0]->is_root);
 342
 343     # try root to leaf
 344     return $self->kdbx->_trace_lineage($self, $base);
 345 }
 346
 347 =method remove
 348
 349     $object = $object->remove;
 350
 351 Remove the object from the database. If the object is a group, all contained objects are removed as well.
 352
 353 =cut
 354
 355 sub remove {
 356     my $self = shift;
 357     my $parent = $self->parent;
 358     $parent->remove_object($self) if $parent;
 359     return $self;
 360 }
 361
 362 =method tag_list
 363
 364     @tags = $entry->tag_list;
 365
 366 Get a list of tags, split from L</tag> using delimiters C<,>, C<.>, C<:>, C<;> and whitespace.
 367
 368 =cut
 369
 370 sub tag_list {
 371     my $self = shift;
 372     return grep { $_ ne '' } split(/[,\.:;]|\s+/, trim($self->tags) // '');
 373 }
 374
 375 =method custom_icon
 376
 377     $image_data = $object->custom_icon;
 378     $image_data = $object->custom_icon($image_data, %attributes);
 379
 380 Get or set an icon image. Returns C<undef> if there is no custom icon set. Setting a custom icon will change
 381 the L</custom_icon_uuid> attribute.
 382
 383 Custom icon attributes (supported in KDBX4.1 and greater):
 384
 385 =for :list
 386 * C<name> - Name of the icon (text)
 387 * C<last_modification_time> - Just what it says (datetime)
 388
 389 =cut
 390
 391 sub custom_icon {
 392     my $self = shift;
 393     my $kdbx = $self->kdbx;
 394     if (@_) {
 395         my $img = shift;
 396         my $uuid = defined $img ? $kdbx->add_custom_icon($img, @_) : undef;
 397         $self->icon_id(0) if $uuid;
 398         $self->custom_icon_uuid($uuid);
 399         return $img;
 400     }
 401     return $kdbx->custom_icon_data($self->custom_icon_uuid);
 402 }
 403
 404 =method custom_data
 405
 406     \%all_data = $object->custom_data;
 407     $object->custom_data(\%all_data);
 408
 409     \%data = $object->custom_data($key);
 410     $object->custom_data($key => \%data);
 411     $object->custom_data(%data);
 412     $object->custom_data(key => $value, %data);
 413
 414 Get and set custom data. Custom data is metadata associated with an object.
 415
 416 Each data item can have a few attributes associated with it.
 417
 418 =for :list
 419 * C<key> - A unique text string identifier used to look up the data item (required)
 420 * C<value> - A text string value (required)
 421 * C<last_modification_time> (optional, KDBX4.1+)
 422
 423 =cut
 424
 425 sub custom_data {
 426     my $self = shift;
 427     $self->{custom_data} = shift if @_ == 1 && is_plain_hashref($_[0]);
 428     return $self->{custom_data} //= {} if !@_;
 429
 430     my %args = @_     == 2 ? (key => shift, value => shift)
 431              : @_ % 2 == 1 ? (key => shift, @_) : @_;
 432
 433     if (!$args{key} && !$args{value}) {
 434         my %standard = (key => 1, value => 1, last_modification_time => 1);
 435         my @other_keys = grep { !$standard{$_} } keys %args;
 436         if (@other_keys == 1) {
 437             my $key = $args{key} = $other_keys[0];
 438             $args{value} = delete $args{$key};
 439         }
 440     }
 441
 442     my $key = $args{key} or throw 'Must provide a custom_data key to access';
 443
 444     return $self->{custom_data}{$key} = $args{value} if is_plain_hashref($args{value});
 445
 446     while (my ($field, $value) = each %args) {
 447         $self->{custom_data}{$key}{$field} = $value;
 448     }
 449     return $self->{custom_data}{$key};
 450 }
 451
 452 =method custom_data_value
 453
 454     $value = $object->custom_data_value($key);
 455
 456 Exactly the same as L</custom_data> except returns just the custom data's value rather than a structure of
 457 attributes. This is a shortcut for:
 458
 459     my $data = $object->custom_data($key);
 460     my $value = defined $data ? $data->{value} : undef;
 461
 462 =cut
 463
 464 sub custom_data_value {
 465     my $self = shift;
 466     my $data = $self->custom_data(@_) // return undef;
 467     return $data->{value};
 468 }
 469
 470 ##############################################################################
 471
 472 =method begin_work
 473
 474     $txn = $object->begin_work(%options);
 475     $object->begin_work(%options);
 476
 477 Begin a new transaction. Returns a L<File::KDBX::Transaction> object that can be scoped to ensure a rollback
 478 occurs if exceptions are thrown. Alternatively, if called in void context, there will be no
 479 B<File::KDBX::Transaction> and it is instead your responsibility to call L</commit> or L</rollback> as
 480 appropriate. It is undefined behavior to call these if a B<File::KDBX::Transaction> exists. Recursive
 481 transactions are allowed.
 482
 483 Signals created during a transaction are delayed until all transactions are resolved. If the outermost
 484 transaction is committed, then the signals are de-duplicated and delivered. Otherwise the signals are dropped.
 485 This means that the KDBX database will not fix broken references or mark itself dirty until after the
 486 transaction is committed.
 487
 488 How it works: With the beginning of a transaction, a snapshot of the object is created. In the event of
 489 a rollback, the object's data is replaced with data from the snapshot.
 490
 491 By default, the snapshot is shallow (i.e. does not include subroups, entries or historical entries). This
 492 means that only modifications to the object itself (its data, fields, strings, etc.) are atomic; modifications
 493 to subroups etc., including adding or removing items, are auto-committed instantly and will persist regardless
 494 of the result of the pending transaction. You can override this for groups, entries and history independently
 495 using options:
 496
 497 =for :list
 498 * C<entries> - If set, snapshot entries within a group, deeply (default: false)
 499 * C<groups> - If set, snapshot subroups within a group, deeply (default: false)
 500 * C<history> - If set, snapshot historical entries within an entry (default: false)
 501
 502 For example, if you begin a transaction on a group object using the C<entries> option, like this:
 503
 504     $group->begin_work(entries => 1);
 505
 506 Then if you modify any of the group's entries OR add new entries OR delete entries, all of that will be undone
 507 if the transaction is rolled back. With a default-configured transaction, however, changes to entries are kept
 508 even if the transaction is rolled back.
 509
 510 =cut
 511
 512 sub begin_work {
 513     my $self = shift;
 514
 515     if (defined wantarray) {
 516         require File::KDBX::Transaction;
 517         return File::KDBX::Transaction->new($self, @_);
 518     }
 519
 520     my %args = @_;
 521     my $orig = $args{snapshot} // do {
 522         my $c = $self->clone(
 523             entries => $args{entries} // 0,
 524             groups  => $args{groups}  // 0,
 525             history => $args{history} // 0,
 526         );
 527         $c->{entries} = $self->{entries} if !$args{entries};
 528         $c->{groups}  = $self->{groups}  if !$args{groups};
 529         $c->{history} = $self->{history} if !$args{history};
 530         $c;
 531     };
 532
 533     my $id = Hash::Util::FieldHash::id($orig);
 534     _save_references($id, $self, $orig);
 535
 536     $self->_signal_begin_work;
 537
 538     push @{$self->_txns}, $orig;
 539 }
 540
 541 =method commit
 542
 543     $object->commit;
 544
 545 Commit a transaction, making updates to C<$object> permanent. Returns itself to allow method chaining.
 546
 547 =cut
 548
 549 sub commit {
 550     my $self = shift;
 551     my $orig = pop @{$self->_txns} or return $self;
 552     $self->_commit($orig);
 553     my $signals = $self->_signal_commit;
 554     $self->_signal_send($signals) if !$self->_in_txn;
 555     return $self;
 556 }
 557
 558 =method rollback
 559
 560     $object->rollback;
 561
 562 Roll back the most recent transaction, throwing away any updates to the L</object> made since the transaction
 563 began. Returns itself to allow method chaining.
 564
 565 =cut
 566
 567 sub rollback {
 568     my $self = shift;
 569
 570     my $orig = pop @{$self->_txns} or return $self;
 571
 572     my $id = Hash::Util::FieldHash::id($orig);
 573     _restore_references($id, $orig);
 574
 575     $self->_signal_rollback;
 576
 577     return $self;
 578 }
 579
 580 # Get whether or not there is at least one pending transaction.
 581 sub _in_txn { scalar @{$_[0]->_txns} }
 582
 583 # Get an array ref of pending transactions.
 584 sub _txns   { $TXNS{$_[0]} //= [] }
 585
 586 # The _commit hook notifies subclasses that a commit has occurred.
 587 sub _commit { die 'Not implemented' }
 588
 589 # Get a reference to an object that represents an object's committed state. If there is no pending
 590 # transaction, this is just $self. If there is a transaction, this is the snapshot take before the transaction
 591 # began. This method is private because it provides direct access to the actual snapshot. It is important that
 592 # the snapshot not be changed or a rollback would roll back to an altered state.
 593 # This is used by File::KDBX::Dumper::XML so as to not dump uncommitted changes.
 594 sub _committed {
 595     my $self = shift;
 596     my ($orig) = @{$self->_txns};
 597     return $orig // $self;
 598 }
 599
 600 # In addition to cloning an object when beginning work, we also keep track its hashrefs and arrayrefs
 601 # internally so that we can restore to the very same structures in the case of a rollback.
 602 sub _save_references {
 603     my $id   = shift;
 604     my $self = shift;
 605     my $orig = shift;
 606
 607     if (is_plain_arrayref($orig)) {
 608         for (my $i = 0; $i < @$orig; ++$i) {
 609             _save_references($id, $self->[$i], $orig->[$i]);
 610         }
 611         $REFS{$id}{Hash::Util::FieldHash::id($orig)} = $self;
 612     }
 613     elsif (is_plain_hashref($orig) || (blessed $orig && $orig->isa(__PACKAGE__))) {
 614         for my $key (keys %$orig) {
 615             _save_references($id, $self->{$key}, $orig->{$key});
 616         }
 617         $REFS{$id}{Hash::Util::FieldHash::id($orig)} = $self;
 618     }
 619 }
 620
 621 # During a rollback, copy data from the snapshot back into the original internal structures.
 622 sub _restore_references {
 623     my $id   = shift;
 624     my $orig = shift // return;
 625     my $self = delete $REFS{$id}{Hash::Util::FieldHash::id($orig) // ''} // return $orig;
 626
 627     if (is_plain_arrayref($orig)) {
 628         @$self = map { _restore_references($id, $_) } @$orig;
 629     }
 630     elsif (is_plain_hashref($orig) || (blessed $orig && $orig->isa(__PACKAGE__))) {
 631         for my $key (keys %$orig) {
 632             # next if is_ref($orig->{$key}) &&
 633             #     (Hash::Util::FieldHash::id($self->{$key}) // 0) == Hash::Util::FieldHash::id($orig->{$key});
 634             $self->{$key} = _restore_references($id, $orig->{$key});
 635         }
 636     }
 637
 638     return $self;
 639 }
 640
 641 ##############################################################################
 642
 643 sub _signal {
 644     my $self = shift;
 645     my $type = shift;
 646
 647     if ($self->_in_txn) {
 648         my $stack = $self->_signal_stack;
 649         my $queue = $stack->[-1];
 650         push @$queue, [$type, @_];
 651     }
 652
 653     $self->_signal_send([[$type, @_]]);
 654
 655     return $self;
 656 }
 657
 658 sub _signal_stack { $SIGNALS{$_[0]} //= [] }
 659
 660 sub _signal_begin_work {
 661     my $self = shift;
 662     push @{$self->_signal_stack}, [];
 663 }
 664
 665 sub _signal_commit {
 666     my $self = shift;
 667     my $signals = pop @{$self->_signal_stack};
 668     my $previous = $self->_signal_stack->[-1] // [];
 669     push @$previous, @$signals;
 670     return $previous;
 671 }
 672
 673 sub _signal_rollback {
 674     my $self = shift;
 675     pop @{$self->_signal_stack};
 676 }
 677
 678 sub _signal_send {
 679     my $self    = shift;
 680     my $signals = shift // [];
 681
 682     my $kdbx = $KDBX{$self} or return;
 683
 684     # de-duplicate, keeping the most recent signal for each type
 685     my %seen;
 686     my @signals = grep { !$seen{$_->[0]}++ } reverse @$signals;
 687
 688     for my $sig (reverse @signals) {
 689         $kdbx->_handle_signal($self, @$sig);
 690     }
 691 }
 692
 693 ##############################################################################
 694
 695 sub _wrap_group {
 696     my $self  = shift;
 697     my $group = shift;
 698     require File::KDBX::Group;
 699     return File::KDBX::Group->wrap($group, $KDBX{$self});
 700 }
 701
 702 sub _wrap_entry {
 703     my $self  = shift;
 704     my $entry = shift;
 705     require File::KDBX::Entry;
 706     return File::KDBX::Entry->wrap($entry, $KDBX{$self});
 707 }
 708
 709 sub TO_JSON { +{%{$_[0]}} }
 710
 711 1;
 712 __END__
 713
 714 =for Pod::Coverage STORABLE_freeze STORABLE_thaw TO_JSON
 715
 716 =head1 DESCRIPTION
 717
 718 KDBX is an object database. This abstract class represents an object. You should not use this class directly
 719 but instead use its subclasses:
 720
 721 =for :list
 722 * L<File::KDBX::Entry>
 723 * L<File::KDBX::Group>
 724
 725 There is some functionality shared by both types of objects, and that's what this class provides.
 726
 727 Each object can be associated with a L<File::KDBX> database or be disassociated. A disassociated object will
 728 not be persisted when dumping a database. It is also possible for an object to be associated with a database
 729 but not be part of the object tree (i.e. is not the root group or any subroup or entry). A disassociated
 730 object or an object not part of the object tree of a database can be added to a database using one of:
 731
 732 =for :list
 733 * L<File::KDBX/add_entry>
 734 * L<File::KDBX/add_group>
 735 * L<File::KDBX::Group/add_entry>
 736 * L<File::KDBX::Group/add_group>
 737 * L<File::KDBX::Entry/add_historical_entry>
 738
 739 It is possible to copy or move objects between databases, but B<DO NOT> include the same object in more
 740 than one database at once or there could some strange aliasing effects (i.e. changes in one database might
 741 effect another in unexpected ways). This could lead to difficult-to-debug problems. It is similarly not safe
 742 or valid to add the same object multiple times to the same database. For example:
 743
 744     my $entry = File::KDBX::Entry->(title => 'Whatever');
 745
 746     # DO NOT DO THIS:
 747     $kdbx->add_entry($entry);
 748     $another_kdbx->add_entry($entry);
 749
 750     # DO NOT DO THIS:
 751     $kdbx->add_entry($entry);
 752     $kdbx->add_entry($entry); # again
 753
 754 Instead, do this:
 755
 756     # Copy an entry to multiple databases:
 757     $kdbx->add_entry($entry);
 758     $another_kdbx->add_entry($entry->clone);
 759
 760     # OR move an existing entry from one database to another:
 761     $kdbx->add_entry($entry->remove);
 762
 763 =cut