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::Constants qw(:bool);
   9 use File::KDBX::Error;
  10 use File::KDBX::Util qw(:uuid);
  11 use Hash::Util::FieldHash qw(fieldhashes);
  12 use List::Util qw(any first);
  13 use Ref::Util qw(is_arrayref is_plain_arrayref is_plain_hashref is_ref);
  14 use Scalar::Util qw(blessed weaken);
  15 use namespace::clean;
  16
  17 our $VERSION = '0.902'; # VERSION
  18
  19 fieldhashes \my (%KDBX, %PARENT, %TXNS, %REFS, %SIGNALS);
  20
  21
  22 sub new {
  23     my $class = shift;
  24
  25     # copy constructor
  26     return $_[0]->clone if @_ == 1 && blessed $_[0] && $_[0]->isa($class);
  27
  28     my $data;
  29     $data = shift if is_plain_hashref($_[0]);
  30
  31     my $kdbx;
  32     $kdbx = shift if @_ % 2 == 1;
  33
  34     my %args = @_;
  35     $args{kdbx} //= $kdbx if defined $kdbx;
  36
  37     my $self = bless $data // {}, $class;
  38     $self->init(%args);
  39     $self->_set_nonlazy_attributes if !$data;
  40     return $self;
  41 }
  42
  43 sub _set_nonlazy_attributes { die 'Not implemented' }
  44
  45
  46 sub init {
  47     my $self = shift;
  48     my %args = @_;
  49
  50     while (my ($key, $val) = each %args) {
  51         if (my $method = $self->can($key)) {
  52             $self->$method($val);
  53         }
  54     }
  55
  56     return $self;
  57 }
  58
  59
  60 sub wrap {
  61     my $class   = shift;
  62     my $object  = shift;
  63     return $object if blessed $object && $object->isa($class);
  64     return $class->new(@_, @$object) if is_arrayref($object);
  65     return $class->new($object, @_);
  66 }
  67
  68
  69 sub label { die 'Not implemented' }
  70
  71
  72 my %CLONE = (entries => 1, groups => 1, history => 1);
  73 sub clone {
  74     my $self = shift;
  75     my %args = @_;
  76
  77     local $CLONE{new_uuid}              = $args{new_uuid} // $args{parent} // 0;
  78     local $CLONE{entries}               = $args{entries}  // 1;
  79     local $CLONE{groups}                = $args{groups}   // 1;
  80     local $CLONE{history}               = $args{history}  // 1;
  81     local $CLONE{reference_password}    = $args{reference_password} // 0;
  82     local $CLONE{reference_username}    = $args{reference_username} // 0;
  83
  84     require Storable;
  85     my $copy = Storable::dclone($self);
  86
  87     if ($args{relabel} and my $label = $self->label) {
  88         $copy->label("$label - Copy");
  89     }
  90     if ($args{parent} and my $parent = $self->group) {
  91         $parent->add_object($copy);
  92     }
  93
  94     return $copy;
  95 }
  96
  97 sub STORABLE_freeze {
  98     my $self    = shift;
  99     my $cloning = shift;
 100
 101     my $copy = {%$self};
 102     delete $copy->{entries} if !$CLONE{entries};
 103     delete $copy->{groups}  if !$CLONE{groups};
 104     delete $copy->{history} if !$CLONE{history};
 105
 106     return ($cloning ? Hash::Util::FieldHash::id($self) : ''), $copy;
 107 }
 108
 109 sub STORABLE_thaw {
 110     my $self    = shift;
 111     my $cloning = shift;
 112     my $addr    = shift;
 113     my $copy    = shift;
 114
 115     @$self{keys %$copy} = values %$copy;
 116
 117     if ($cloning) {
 118         my $kdbx = $KDBX{$addr};
 119         $self->kdbx($kdbx) if $kdbx;
 120     }
 121
 122     if (defined $self->{uuid}) {
 123         if (($CLONE{reference_password} || $CLONE{reference_username}) && $self->can('strings')) {
 124             my $uuid = format_uuid($self->{uuid});
 125             my $clone_obj = do {
 126                 local $CLONE{new_uuid}              = 0;
 127                 local $CLONE{entries}               = 1;
 128                 local $CLONE{groups}                = 1;
 129                 local $CLONE{history}               = 1;
 130                 local $CLONE{reference_password}    = 0;
 131                 local $CLONE{reference_username}    = 0;
 132                 # Clone only the entry's data and manually bless to avoid infinite recursion.
 133                 bless Storable::dclone({%$copy}), 'File::KDBX::Entry';
 134             };
 135             my $txn = $self->begin_work(snapshot => $clone_obj);
 136             if ($CLONE{reference_password}) {
 137                 $self->password("{REF:P\@I:$uuid}");
 138             }
 139             if ($CLONE{reference_username}) {
 140                 $self->username("{REF:U\@I:$uuid}");
 141             }
 142             $txn->commit;
 143         }
 144         $self->uuid(generate_uuid) if $CLONE{new_uuid};
 145     }
 146
 147     # Dualvars aren't cloned as dualvars, so dualify the icon.
 148     $self->icon_id($self->{icon_id}) if defined $self->{icon_id};
 149 }
 150
 151
 152 sub kdbx {
 153     my $self = shift;
 154     $self = $self->new if !ref $self;
 155     if (@_) {
 156         if (my $kdbx = shift) {
 157             $KDBX{$self} = $kdbx;
 158             weaken $KDBX{$self};
 159         }
 160         else {
 161             delete $KDBX{$self};
 162         }
 163     }
 164     $KDBX{$self} or throw 'Object is disconnected', object => $self;
 165 }
 166
 167
 168 sub is_connected {
 169     my $self = shift;
 170     return !!eval { $self->kdbx };
 171 }
 172
 173
 174 sub id { format_uuid(shift->uuid, @_) }
 175
 176
 177 sub group {
 178     my $self = shift;
 179
 180     if (my $new_group = shift) {
 181         my $old_group = $self->group;
 182         return $new_group if Hash::Util::FieldHash::id($old_group) == Hash::Util::FieldHash::id($new_group);
 183         # move to a new parent
 184         $self->remove(signal => 0) if $old_group;
 185         $self->location_changed('now');
 186         $new_group->add_object($self);
 187     }
 188
 189     my $id   = Hash::Util::FieldHash::id($self);
 190     if (my $group = $PARENT{$self}) {
 191         my $method = $self->_parent_container;
 192         return $group if first { $id == Hash::Util::FieldHash::id($_) } @{$group->$method};
 193         delete $PARENT{$self};
 194     }
 195     # always get lineage from root to leaf because the other way requires parent, so it would be recursive
 196     my $lineage = $self->kdbx->_trace_lineage($self) or return;
 197     my $group = pop @$lineage or return;
 198     $PARENT{$self} = $group; weaken $PARENT{$self};
 199     return $group;
 200 }
 201
 202 sub _set_group {
 203     my $self = shift;
 204     if (my $parent = shift) {
 205         $PARENT{$self} = $parent;
 206         weaken $PARENT{$self};
 207     }
 208     else {
 209         delete $PARENT{$self};
 210     }
 211     return $self;
 212 }
 213
 214 ### Name of the parent attribute expected to contain the object
 215 sub _parent_container { die 'Not implemented' }
 216
 217
 218 sub lineage {
 219     my $self = shift;
 220     my $base = shift;
 221
 222     my $base_addr = $base ? Hash::Util::FieldHash::id($base) : 0;
 223
 224     # try leaf to root
 225     my @path;
 226     my $object = $self;
 227     while ($object = $object->group) {
 228         unshift @path, $object;
 229         last if $base_addr == Hash::Util::FieldHash::id($object);
 230     }
 231     return \@path if @path && ($base_addr == Hash::Util::FieldHash::id($path[0]) || $path[0]->is_root);
 232
 233     # try root to leaf
 234     return $self->kdbx->_trace_lineage($self, $base);
 235 }
 236
 237
 238 sub remove {
 239     my $self = shift;
 240     my $parent = $self->group;
 241     $parent->remove_object($self, @_) if $parent;
 242     $self->_set_group(undef);
 243     return $self;
 244 }
 245
 246
 247 sub recycle {
 248     my $self = shift;
 249     return $self->group($self->kdbx->recycle_bin);
 250 }
 251
 252
 253 sub recycle_or_remove {
 254     my $self = shift;
 255     my $kdbx = eval { $self->kdbx };
 256     if ($kdbx && $kdbx->recycle_bin_enabled && !$self->is_recycled) {
 257         $self->recycle;
 258     }
 259     else {
 260         $self->remove;
 261     }
 262 }
 263
 264
 265 sub is_recycled {
 266     my $self = shift;
 267     eval { $self->kdbx } or return FALSE;
 268     return !!($self->group && any { $_->is_recycle_bin } @{$self->lineage});
 269 }
 270
 271 ##############################################################################
 272
 273
 274 sub tag_list {
 275     my $self = shift;
 276     return grep { $_ ne '' } split(/[,\.:;]|\s+/, trim($self->tags) // '');
 277 }
 278
 279
 280 sub custom_icon {
 281     my $self = shift;
 282     my $kdbx = $self->kdbx;
 283     if (@_) {
 284         my $img = shift;
 285         my $uuid = defined $img ? $kdbx->add_custom_icon($img, @_) : undef;
 286         $self->icon_id(0) if $uuid;
 287         $self->custom_icon_uuid($uuid);
 288         return $img;
 289     }
 290     return $kdbx->custom_icon_data($self->custom_icon_uuid);
 291 }
 292
 293
 294 sub custom_data {
 295     my $self = shift;
 296     $self->{custom_data} = shift if @_ == 1 && is_plain_hashref($_[0]);
 297     return $self->{custom_data} //= {} if !@_;
 298
 299     my %args = @_     == 2 ? (key => shift, value => shift)
 300              : @_ % 2 == 1 ? (key => shift, @_) : @_;
 301
 302     if (!$args{key} && !$args{value}) {
 303         my %standard = (key => 1, value => 1, last_modification_time => 1);
 304         my @other_keys = grep { !$standard{$_} } keys %args;
 305         if (@other_keys == 1) {
 306             my $key = $args{key} = $other_keys[0];
 307             $args{value} = delete $args{$key};
 308         }
 309     }
 310
 311     my $key = $args{key} or throw 'Must provide a custom_data key to access';
 312
 313     return $self->{custom_data}{$key} = $args{value} if is_plain_hashref($args{value});
 314
 315     while (my ($field, $value) = each %args) {
 316         $self->{custom_data}{$key}{$field} = $value;
 317     }
 318     return $self->{custom_data}{$key};
 319 }
 320
 321
 322 sub custom_data_value {
 323     my $self = shift;
 324     my $data = $self->custom_data(@_) // return undef;
 325     return $data->{value};
 326 }
 327
 328 ##############################################################################
 329
 330
 331 sub begin_work {
 332     my $self = shift;
 333
 334     if (defined wantarray) {
 335         require File::KDBX::Transaction;
 336         return File::KDBX::Transaction->new($self, @_);
 337     }
 338
 339     my %args = @_;
 340     my $orig = $args{snapshot} // do {
 341         my $c = $self->clone(
 342             entries => $args{entries} // 0,
 343             groups  => $args{groups}  // 0,
 344             history => $args{history} // 0,
 345         );
 346         $c->{entries} = $self->{entries} if !$args{entries};
 347         $c->{groups}  = $self->{groups}  if !$args{groups};
 348         $c->{history} = $self->{history} if !$args{history};
 349         $c;
 350     };
 351
 352     my $id = Hash::Util::FieldHash::id($orig);
 353     _save_references($id, $self, $orig);
 354
 355     $self->_signal_begin_work;
 356
 357     push @{$self->_txns}, $orig;
 358 }
 359
 360
 361 sub commit {
 362     my $self = shift;
 363     my $orig = pop @{$self->_txns} or return $self;
 364     $self->_commit($orig);
 365     my $signals = $self->_signal_commit;
 366     $self->_signal_send($signals) if !$self->_in_txn;
 367     return $self;
 368 }
 369
 370
 371 sub rollback {
 372     my $self = shift;
 373
 374     my $orig = pop @{$self->_txns} or return $self;
 375
 376     my $id = Hash::Util::FieldHash::id($orig);
 377     _restore_references($id, $orig);
 378
 379     $self->_signal_rollback;
 380
 381     return $self;
 382 }
 383
 384 # Get whether or not there is at least one pending transaction.
 385 sub _in_txn { scalar @{$_[0]->_txns} }
 386
 387 # Get an array ref of pending transactions.
 388 sub _txns   { $TXNS{$_[0]} //= [] }
 389
 390 # The _commit hook notifies subclasses that a commit has occurred.
 391 sub _commit { die 'Not implemented' }
 392
 393 # Get a reference to an object that represents an object's committed state. If there is no pending
 394 # transaction, this is just $self. If there is a transaction, this is the snapshot take before the transaction
 395 # began. This method is private because it provides direct access to the actual snapshot. It is important that
 396 # the snapshot not be changed or a rollback would roll back to an altered state.
 397 # This is used by File::KDBX::Dumper::XML so as to not dump uncommitted changes.
 398 sub _committed {
 399     my $self = shift;
 400     my ($orig) = @{$self->_txns};
 401     return $orig // $self;
 402 }
 403
 404 # In addition to cloning an object when beginning work, we also keep track its hashrefs and arrayrefs
 405 # internally so that we can restore to the very same structures in the case of a rollback.
 406 sub _save_references {
 407     my $id   = shift;
 408     my $self = shift;
 409     my $orig = shift;
 410
 411     if (is_plain_arrayref($orig)) {
 412         for (my $i = 0; $i < @$orig; ++$i) {
 413             _save_references($id, $self->[$i], $orig->[$i]);
 414         }
 415         $REFS{$id}{Hash::Util::FieldHash::id($orig)} = $self;
 416     }
 417     elsif (is_plain_hashref($orig) || (blessed $orig && $orig->isa(__PACKAGE__))) {
 418         for my $key (keys %$orig) {
 419             _save_references($id, $self->{$key}, $orig->{$key});
 420         }
 421         $REFS{$id}{Hash::Util::FieldHash::id($orig)} = $self;
 422     }
 423 }
 424
 425 # During a rollback, copy data from the snapshot back into the original internal structures.
 426 sub _restore_references {
 427     my $id   = shift;
 428     my $orig = shift // return;
 429     my $self = delete $REFS{$id}{Hash::Util::FieldHash::id($orig) // ''} // return $orig;
 430
 431     if (is_plain_arrayref($orig)) {
 432         @$self = map { _restore_references($id, $_) } @$orig;
 433     }
 434     elsif (is_plain_hashref($orig) || (blessed $orig && $orig->isa(__PACKAGE__))) {
 435         for my $key (keys %$orig) {
 436             # next if is_ref($orig->{$key}) &&
 437             #     (Hash::Util::FieldHash::id($self->{$key}) // 0) == Hash::Util::FieldHash::id($orig->{$key});
 438             $self->{$key} = _restore_references($id, $orig->{$key});
 439         }
 440     }
 441
 442     return $self;
 443 }
 444
 445 ##############################################################################
 446
 447 sub _signal {
 448     my $self = shift;
 449     my $type = shift;
 450
 451     if ($self->_in_txn) {
 452         my $stack = $self->_signal_stack;
 453         my $queue = $stack->[-1];
 454         push @$queue, [$type, @_];
 455     }
 456
 457     $self->_signal_send([[$type, @_]]);
 458
 459     return $self;
 460 }
 461
 462 sub _signal_stack { $SIGNALS{$_[0]} //= [] }
 463
 464 sub _signal_begin_work {
 465     my $self = shift;
 466     push @{$self->_signal_stack}, [];
 467 }
 468
 469 sub _signal_commit {
 470     my $self = shift;
 471     my $signals = pop @{$self->_signal_stack};
 472     my $previous = $self->_signal_stack->[-1] // [];
 473     push @$previous, @$signals;
 474     return $previous;
 475 }
 476
 477 sub _signal_rollback {
 478     my $self = shift;
 479     pop @{$self->_signal_stack};
 480 }
 481
 482 sub _signal_send {
 483     my $self    = shift;
 484     my $signals = shift // [];
 485
 486     my $kdbx = $KDBX{$self} or return;
 487
 488     # de-duplicate, keeping the most recent signal for each type
 489     my %seen;
 490     my @signals = grep { !$seen{$_->[0]}++ } reverse @$signals;
 491
 492     for my $sig (reverse @signals) {
 493         $kdbx->_handle_signal($self, @$sig);
 494     }
 495 }
 496
 497 ##############################################################################
 498
 499 sub _wrap_group {
 500     my $self  = shift;
 501     my $group = shift;
 502     require File::KDBX::Group;
 503     return File::KDBX::Group->wrap($group, $KDBX{$self});
 504 }
 505
 506 sub _wrap_entry {
 507     my $self  = shift;
 508     my $entry = shift;
 509     require File::KDBX::Entry;
 510     return File::KDBX::Entry->wrap($entry, $KDBX{$self});
 511 }
 512
 513 sub TO_JSON { +{%{$_[0]}} }
 514
 515 1;
 516
 517 __END__
 518
 519 =pod
 520
 521 =encoding UTF-8
 522
 523 =head1 NAME
 524
 525 File::KDBX::Object - A KDBX database object
 526
 527 =head1 VERSION
 528
 529 version 0.902
 530
 531 =head1 DESCRIPTION
 532
 533 KDBX is an object database. This abstract class represents an object. You should not use this class directly
 534 but instead use its subclasses:
 535
 536 =over 4
 537
 538 =item *
 539
 540 L<File::KDBX::Entry>
 541
 542 =item *
 543
 544 L<File::KDBX::Group>
 545
 546 =back
 547
 548 There is some functionality shared by both types of objects, and that's what this class provides.
 549
 550 Each object can be connected with a L<File::KDBX> database or be disconnected. A disconnected object exists in
 551 memory but will not be persisted when dumping a database. It is also possible for an object to be connected
 552 with a database but not be part of the object tree (i.e. is not the root group or any subroup or entry).
 553 A disconnected object or an object not part of the object tree of a database can be added to a database using
 554 one of:
 555
 556 =over 4
 557
 558 =item *
 559
 560 L<File::KDBX/add_entry>
 561
 562 =item *
 563
 564 L<File::KDBX/add_group>
 565
 566 =item *
 567
 568 L<File::KDBX::Group/add_entry>
 569
 570 =item *
 571
 572 L<File::KDBX::Group/add_group>
 573
 574 =item *
 575
 576 L<File::KDBX::Entry/add_historical_entry>
 577
 578 =back
 579
 580 It is possible to copy or move objects between databases, but B<DO NOT> include the same object in more
 581 than one database at once or there could be some strange aliasing effects (i.e. changes in one database might
 582 effect another in unexpected ways). This could lead to difficult-to-debug problems. It is similarly not safe
 583 or valid to add the same object multiple times to the same database. For example:
 584
 585     my $entry = File::KDBX::Entry->(title => 'Whatever');
 586
 587     # DO NOT DO THIS:
 588     $kdbx->add_entry($entry);
 589     $another_kdbx->add_entry($entry);
 590
 591     # DO NOT DO THIS:
 592     $kdbx->add_entry($entry);
 593     $kdbx->add_entry($entry); # again
 594
 595 Instead, do this:
 596
 597     # Copy an entry to multiple databases:
 598     $kdbx->add_entry($entry);
 599     $another_kdbx->add_entry($entry->clone);
 600
 601     # OR move an existing entry from one database to another:
 602     $another_kdbx->add_entry($entry->remove);
 603
 604 =head1 ATTRIBUTES
 605
 606 =head2 kdbx
 607
 608     $kdbx = $object->kdbx;
 609     $object->kdbx($kdbx);
 610
 611 Get or set the L<File::KDBX> instance connected with this object. Throws if the object is disconnected. Other
 612 object methods might only work if the object is connected to a database and so they might also throw if the
 613 object is disconnected. If you're not sure if an object is connected, try L</is_connected>.
 614
 615 =head2 uuid
 616
 617 128-bit UUID identifying the object within the connected database.
 618
 619 =head2 icon_id
 620
 621 Integer representing a default icon. See L<File::KDBX::Constants/":icon"> for valid values.
 622
 623 =head2 custom_icon_uuid
 624
 625 128-bit UUID identifying a custom icon within the connected database.
 626
 627 =head2 tags
 628
 629 Text string with arbitrary tags which can be used to build a taxonomy.
 630
 631 =head2 previous_parent_group
 632
 633 128-bit UUID identifying a group within the connected database the previously contained the object.
 634
 635 =head2 last_modification_time
 636
 637 Date and time when the entry was last modified.
 638
 639 =head2 creation_time
 640
 641 Date and time when the entry was created.
 642
 643 =head2 last_access_time
 644
 645 Date and time when the entry was last accessed.
 646
 647 =head2 expiry_time
 648
 649 Date and time when the entry expired or will expire.
 650
 651 =head2 expires
 652
 653 Boolean value indicating whether or not an entry is expired.
 654
 655 =head2 usage_count
 656
 657 The number of times an entry has been used, which typically means how many times the B<Password> string has
 658 been accessed.
 659
 660 =head2 location_changed
 661
 662 Date and time when the entry was last moved to a different parent group.
 663
 664 =head1 METHODS
 665
 666 =head2 new
 667
 668     $object = File::KDBX::Object->new;
 669     $object = File::KDBX::Object->new(%attributes);
 670     $object = File::KDBX::Object->new(\%data);
 671     $object = File::KDBX::Object->new(\%data, $kdbx);
 672
 673 Construct a new KDBX object.
 674
 675 There is a subtlety to take note of. There is a significant difference between:
 676
 677     File::KDBX::Entry->new(username => 'iambatman');
 678
 679 and:
 680
 681     File::KDBX::Entry->new({username => 'iambatman'}); # WRONG
 682
 683 In the first, an empty object is first created and then initialized with whatever I<attributes> are given. In
 684 the second, a hashref is blessed and essentially becomes the object. The significance is that the hashref
 685 key-value pairs will remain as-is so the structure is expected to adhere to the shape of a raw B<Object>
 686 (which varies based on the type of object), whereas with the first the attributes will set the structure in
 687 the correct way (just like using the object accessors / getters / setters).
 688
 689 The second example isn't I<generally> wrong -- this type of construction is supported for a reason, to allow
 690 for working with KDBX objects at a low level -- but it is wrong in this specific case only because
 691 C<< {username => $str} >> isn't a valid raw KDBX entry object. The L</username> attribute is really a proxy
 692 for the C<UserName> string, so the equivalent raw entry object should be
 693 C<< {strings => {UserName => {value => $str}}} >>. These are roughly equivalent:
 694
 695     File::KDBX::Entry->new(username => 'iambatman');
 696     File::KDBX::Entry->new({strings => {UserName => {value => 'iambatman'}}});
 697
 698 If this explanation went over your head, that's fine. Just stick with the attributes since they are typically
 699 easier to use correctly and provide the most convenience. If in the future you think of some kind of KDBX
 700 object manipulation you want to do that isn't supported by the accessors and methods, just know you I<can>
 701 access an object's data directly.
 702
 703 =head2 init
 704
 705     $object = $object->init(%attributes);
 706
 707 Called by the constructor to set attributes. You normally should not call this.
 708
 709 =head2 wrap
 710
 711     $object = File::KDBX::Object->wrap($object);
 712
 713 Ensure that a KDBX object is blessed.
 714
 715 =head2 label
 716
 717     $label = $object->label;
 718     $object->label($label);
 719
 720 Get or set the object's label, a text string that can act as a non-unique identifier. For an entry, the label
 721 is its title string. For a group, the label is its name.
 722
 723 =head2 clone
 724
 725     $object_copy = $object->clone(%options);
 726     $object_copy = File::KDBX::Object->new($object);
 727
 728 Make a clone of an object. By default the clone is indeed an exact copy that is connected to the same database
 729 but not actually included in the object tree (i.e. it has no parent group). Some options are allowed to get
 730 different effects:
 731
 732 =over 4
 733
 734 =item *
 735
 736 C<new_uuid> - If set, generate a new UUID for the copy (default: false)
 737
 738 =item *
 739
 740 C<parent> - If set, add the copy to the same parent group, if any (default: false)
 741
 742 =item *
 743
 744 C<relabel> - If set, append " - Copy" to the object's title or name (default: false)
 745
 746 =item *
 747
 748 C<entries> - If set, copy child entries, if any (default: true)
 749
 750 =item *
 751
 752 C<groups> - If set, copy child groups, if any (default: true)
 753
 754 =item *
 755
 756 C<history> - If set, copy entry history, if any (default: true)
 757
 758 =item *
 759
 760 C<reference_password> - Toggle whether or not cloned entry's Password string should be set as a field reference to the original entry's Password string (default: false)
 761
 762 =item *
 763
 764 C<reference_username> - Toggle whether or not cloned entry's UserName string should be set as a field reference to the original entry's UserName string (default: false)
 765
 766 =back
 767
 768 =head2 is_connected
 769
 770     $bool = $object->is_connected;
 771
 772 Determine whether or not an object is connected to a database.
 773
 774 =head2 id
 775
 776     $string_uuid = $object->id;
 777     $string_uuid = $object->id($delimiter);
 778
 779 Get the unique identifier for this object as a B<formatted> UUID string, typically for display purposes. You
 780 could use this to compare with other identifiers formatted with the same delimiter, but it is more efficient
 781 to use the raw UUID for that purpose (see L</uuid>).
 782
 783 A delimiter can optionally be provided to break up the UUID string visually. See
 784 L<File::KDBX::Util/format_uuid>.
 785
 786 =head2 group
 787
 788     $parent_group = $object->group;
 789     $object->group($parent_group);
 790
 791 Get or set the parent group to which an object belongs or C<undef> if it belongs to no group.
 792
 793 =head2 lineage
 794
 795     \@lineage = $object->lineage;
 796     \@lineage = $object->lineage($base_group);
 797
 798 Get the direct line of ancestors from C<$base_group> (default: the root group) to an object. The lineage
 799 includes the base group but I<not> the target object. Returns C<undef> if the target is not in the database
 800 structure. Returns an empty arrayref is the object itself is a root group.
 801
 802 =head2 remove
 803
 804     $object = $object->remove(%options);
 805
 806 Remove an object from its parent. If the object is a group, all contained objects stay with the object and so
 807 are removed as well, just like cutting off a branch takes the leafs as well. Options:
 808
 809 =over 4
 810
 811 =item *
 812
 813 C<signal> Whether or not to signal the removal to the connected database (default: true)
 814
 815 =back
 816
 817 =head2 recycle
 818
 819     $object = $object->recycle;
 820
 821 Remove an object from its parent and add it to the connected database's recycle bin group.
 822
 823 =head2 recycle_or_remove
 824
 825     $object = $object->recycle_or_remove;
 826
 827 Recycle or remove an object, depending on the connected database's L<File::KDBX/recycle_bin_enabled>. If the
 828 object is not connected to a database or is already in the recycle bin, remove it.
 829
 830 =head2 is_recycled
 831
 832     $bool = $object->is_recycled;
 833
 834 Get whether or not an object is in a recycle bin.
 835
 836 =head2 tag_list
 837
 838     @tags = $entry->tag_list;
 839
 840 Get a list of tags, split from L</tag> using delimiters C<,>, C<.>, C<:>, C<;> and whitespace.
 841
 842 =head2 custom_icon
 843
 844     $image_data = $object->custom_icon;
 845     $image_data = $object->custom_icon($image_data, %attributes);
 846
 847 Get or set an icon image. Returns C<undef> if there is no custom icon set. Setting a custom icon will change
 848 the L</custom_icon_uuid> attribute.
 849
 850 Custom icon attributes (supported in KDBX4.1 and greater):
 851
 852 =over 4
 853
 854 =item *
 855
 856 C<name> - Name of the icon (text)
 857
 858 =item *
 859
 860 C<last_modification_time> - Just what it says (datetime)
 861
 862 =back
 863
 864 =head2 custom_data
 865
 866     \%all_data = $object->custom_data;
 867     $object->custom_data(\%all_data);
 868
 869     \%data = $object->custom_data($key);
 870     $object->custom_data($key => \%data);
 871     $object->custom_data(%data);
 872     $object->custom_data(key => $value, %data);
 873
 874 Get and set custom data. Custom data is metadata associated with an object. It is a set of key-value pairs
 875 used to store arbitrary data, usually used by software like plug-ins to keep track of state rather than by end
 876 users.
 877
 878 Each data item can have a few attributes associated with it.
 879
 880 =over 4
 881
 882 =item *
 883
 884 C<key> - A unique text string identifier used to look up the data item (required)
 885
 886 =item *
 887
 888 C<value> - A text string value (required)
 889
 890 =item *
 891
 892 C<last_modification_time> (optional, KDBX4.1+)
 893
 894 =back
 895
 896 =head2 custom_data_value
 897
 898     $value = $object->custom_data_value($key);
 899
 900 Exactly the same as L</custom_data> except returns just the custom data's value rather than a structure of
 901 attributes. This is a shortcut for:
 902
 903     my $data = $object->custom_data($key);
 904     my $value = defined $data ? $data->{value} : undef;
 905
 906 =head2 begin_work
 907
 908     $txn = $object->begin_work(%options);
 909     $object->begin_work(%options);
 910
 911 Begin a new transaction. Returns a L<File::KDBX::Transaction> object that can be scoped to ensure a rollback
 912 occurs if exceptions are thrown. Alternatively, if called in void context, there will be no
 913 B<File::KDBX::Transaction> and it is instead your responsibility to call L</commit> or L</rollback> as
 914 appropriate. It is undefined behavior to call these if a B<File::KDBX::Transaction> exists. Recursive
 915 transactions are allowed.
 916
 917 Signals created during a transaction are delayed until all transactions are resolved. If the outermost
 918 transaction is committed, then the signals are de-duplicated and delivered. Otherwise the signals are dropped.
 919 This means that the KDBX database will not fix broken references or mark itself dirty until after the
 920 transaction is committed.
 921
 922 How it works: With the beginning of a transaction, a snapshot of the object is created. In the event of
 923 a rollback, the object's data is replaced with data from the snapshot.
 924
 925 By default, the snapshot is shallow (i.e. does not include subroups, entries or historical entries). This
 926 means that only modifications to the object itself (its data, fields, strings, etc.) are atomic; modifications
 927 to subroups etc., including adding or removing items, are auto-committed instantly and will persist regardless
 928 of the result of the pending transaction. You can override this for groups, entries and history independently
 929 using options:
 930
 931 =over 4
 932
 933 =item *
 934
 935 C<entries> - If set, snapshot entries within a group, deeply (default: false)
 936
 937 =item *
 938
 939 C<groups> - If set, snapshot subroups within a group, deeply (default: false)
 940
 941 =item *
 942
 943 C<history> - If set, snapshot historical entries within an entry (default: false)
 944
 945 =back
 946
 947 For example, if you begin a transaction on a group object using the C<entries> option, like this:
 948
 949     $group->begin_work(entries => 1);
 950
 951 Then if you modify any of the group's entries OR add new entries OR delete entries, all of that will be undone
 952 if the transaction is rolled back. With a default-configured transaction, however, changes to entries are kept
 953 even if the transaction is rolled back.
 954
 955 =head2 commit
 956
 957     $object->commit;
 958
 959 Commit a transaction, making updates to C<$object> permanent. Returns itself to allow method chaining.
 960
 961 =head2 rollback
 962
 963     $object->rollback;
 964
 965 Roll back the most recent transaction, throwing away any updates to the L</object> made since the transaction
 966 began. Returns itself to allow method chaining.
 967
 968 =for Pod::Coverage STORABLE_freeze STORABLE_thaw TO_JSON
 969
 970 =head1 BUGS
 971
 972 Please report any bugs or feature requests on the bugtracker website
 973 L<https://github.com/chazmcgarvey/File-KDBX/issues>
 974
 975 When submitting a bug or request, please include a test-file or a
 976 patch to an existing test-file that illustrates the bug or desired
 977 feature.
 978
 979 =head1 AUTHOR
 980
 981 Charles McGarvey <ccm@cpan.org>
 982
 983 =head1 COPYRIGHT AND LICENSE
 984
 985 This software is copyright (c) 2022 by Charles McGarvey.
 986
 987 This is free software; you can redistribute it and/or modify it under
 988 the same terms as the Perl 5 programming language system itself.
 989
 990 =cut