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

   1 package File::KDBX::Group;
   2 # ABSTRACT: A KDBX database group
   3
   4 use warnings;
   5 use strict;
   6
   7 use Devel::GlobalDestruction;
   8 use File::KDBX::Constants qw(:icon);
   9 use File::KDBX::Error;
  10 use File::KDBX::Util qw(generate_uuid);
  11 use List::Util qw(sum0);
  12 use Ref::Util qw(is_ref);
  13 use Scalar::Util qw(blessed);
  14 use Time::Piece;
  15 use boolean;
  16 use namespace::clean;
  17
  18 use parent 'File::KDBX::Object';
  19
  20 our $VERSION = '999.999'; # VERSION
  21
  22 my @ATTRS = qw(uuid custom_data entries groups);
  23 my %ATTRS = (
  24     # uuid                        => sub { generate_uuid(printable => 1) },
  25     name                        => '',
  26     notes                       => '',
  27     tags                        => '',
  28     icon_id                     => ICON_FOLDER,
  29     custom_icon_uuid            => undef,
  30     is_expanded                 => false,
  31     default_auto_type_sequence  => '',
  32     enable_auto_type            => undef,
  33     enable_searching            => undef,
  34     last_top_visible_entry      => undef,
  35     # custom_data                 => sub { +{} },
  36     previous_parent_group       => undef,
  37     # entries                     => sub { +[] },
  38     # groups                      => sub { +[] },
  39 );
  40 my %ATTRS_TIMES = (
  41     last_modification_time  => sub { gmtime },
  42     creation_time           => sub { gmtime },
  43     last_access_time        => sub { gmtime },
  44     expiry_time             => sub { gmtime },
  45     expires                 => false,
  46     usage_count             => 0,
  47     location_changed        => sub { gmtime },
  48 );
  49
  50 while (my ($attr, $default) = each %ATTRS) {
  51     no strict 'refs'; ## no critic (ProhibitNoStrict)
  52     *{$attr} = sub {
  53         my $self = shift;
  54         $self->{$attr} = shift if @_;
  55         $self->{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
  56     };
  57 }
  58 while (my ($attr, $default) = each %ATTRS_TIMES) {
  59     no strict 'refs'; ## no critic (ProhibitNoStrict)
  60     *{$attr} = sub {
  61         my $self = shift;
  62         $self->{times}{$attr} = shift if @_;
  63         $self->{times}{$attr} //= (ref $default eq 'CODE') ? $default->($self) : $default;
  64     };
  65 }
  66
  67 sub _set_default_attributes {
  68     my $self = shift;
  69     $self->$_ for @ATTRS, keys %ATTRS, keys %ATTRS_TIMES;
  70 }
  71
  72 sub uuid {
  73     my $self = shift;
  74     if (@_ || !defined $self->{uuid}) {
  75         my %args = @_ % 2 == 1 ? (uuid => shift, @_) : @_;
  76         my $old_uuid = $self->{uuid};
  77         my $uuid = $self->{uuid} = delete $args{uuid} // generate_uuid;
  78         # if (defined $old_uuid and my $kdbx = $KDBX{refaddr($self)}) {
  79         #     $kdbx->_update_group_uuid($old_uuid, $uuid, $self);
  80         # }
  81     }
  82     $self->{uuid};
  83 }
  84
  85 sub label { shift->name(@_) }
  86
  87 sub entries {
  88     my $self = shift;
  89     my $entries = $self->{entries} //= [];
  90     require File::KDBX::Entry;
  91     @$entries = map { File::KDBX::Entry->wrap($_, $self->kdbx) } @$entries;
  92     return $entries;
  93 }
  94
  95 sub groups {
  96     my $self = shift;
  97     my $groups = $self->{groups} //= [];
  98     @$groups = map { File::KDBX::Group->wrap($_, $self->kdbx) } @$groups;
  99     return $groups;
 100 }
 101
 102 sub _kpx_groups { shift->groups(@_) }
 103
 104 sub all_groups {
 105     my $self = shift;
 106     return $self->kdbx->all_groups(base => $self, include_base => false);
 107 }
 108
 109 sub all_entries {
 110     my $self = shift;
 111     return $self->kdbx->all_entries(base => $self);
 112 }
 113
 114 sub _group {
 115     my $self  = shift;
 116     my $group = shift;
 117     return File::KDBX::Group->wrap($group, $self);
 118 }
 119
 120 sub _entry {
 121     my $self  = shift;
 122     my $entry = shift;
 123     require File::KDBX::Entry;
 124     return File::KDBX::Entry->wrap($entry, $self);
 125 }
 126
 127 sub add_entry {
 128     my $self = shift;
 129     my $entry = shift;
 130     push @{$self->{entries} ||= []}, $entry;
 131     return $entry;
 132 }
 133
 134 sub add_group {
 135     my $self = shift;
 136     my $group = shift;
 137     push @{$self->{groups} ||= []}, $group;
 138     return $group;
 139 }
 140
 141 sub add_object {
 142     my $self = shift;
 143     my $obj  = shift;
 144     if ($obj->isa('File::KDBX::Entry')) {
 145         $self->add_entry($obj);
 146     }
 147     elsif ($obj->isa('File::KDBX::Group')) {
 148         $self->add_group($obj);
 149     }
 150 }
 151
 152 sub remove_object {
 153     my $self = shift;
 154     my $object = shift;
 155     my $blessed = blessed($object);
 156     return $self->remove_group($object, @_) if $blessed && $object->isa('File::KDBX::Group');
 157     return $self->remove_entry($object, @_) if $blessed && $object->isa('File::KDBX::Entry');
 158     return $self->remove_group($object, @_) || $self->remove_entry($object, @_);
 159 }
 160
 161 sub remove_group {
 162     my $self = shift;
 163     my $uuid = is_ref($_[0]) ? $self->_group(shift)->uuid : shift;
 164     my $objects = $self->{groups};
 165     for (my $i = 0; $i < @$objects; ++$i) {
 166         my $o = $objects->[$i];
 167         next if $uuid ne $o->uuid;
 168         return splice @$objects, $i, 1;
 169     }
 170 }
 171
 172 sub remove_entry {
 173     my $self = shift;
 174     my $uuid = is_ref($_[0]) ? $self->_entry(shift)->uuid : shift;
 175     my $objects = $self->{entries};
 176     for (my $i = 0; $i < @$objects; ++$i) {
 177         my $o = $objects->[$i];
 178         next if $uuid ne $o->uuid;
 179         return splice @$objects, $i, 1;
 180     }
 181 }
 182
 183 sub path {
 184     my $self = shift;
 185     my $lineage = $self->kdbx->trace_lineage($self) or return;
 186     return join('.', map { $_->name } @$lineage);
 187 }
 188
 189 sub size {
 190     my $self = shift;
 191     return sum0 map { $_->size } @{$self->groups}, @{$self->entries};
 192 }
 193
 194 sub level { $_[0]->kdbx->group_level($_[0]) }
 195
 196 sub TO_JSON { +{%{$_[0]}} }
 197
 198 1;
 199 __END__
 200
 201 =head1 DESCRIPTION
 202
 203 =attr uuid
 204
 205 =attr name
 206
 207 =attr notes
 208
 209 =attr tags
 210
 211 =attr icon_id
 212
 213 =attr custom_icon_uuid
 214
 215 =attr is_expanded
 216
 217 =attr default_auto_type_sequence
 218
 219 =attr enable_auto_type
 220
 221 =attr enable_searching
 222
 223 =attr last_top_visible_entry
 224
 225 =attr custom_data
 226
 227 =attr previous_parent_group
 228
 229 =attr entries
 230
 231 =attr groups
 232
 233 =attr last_modification_time
 234
 235 =attr creation_time
 236
 237 =attr last_access_time
 238
 239 =attr expiry_time
 240
 241 =attr expires
 242
 243 =attr usage_count
 244
 245 =attr location_changed
 246
 247 Get or set various group fields.
 248
 249 =cut