Add recursive transactions

[chaz/p5-File-KDBX] / lib / File / KDBX / Dumper.pm

diff --git a/lib/File/KDBX/Dumper.pm b/lib/File/KDBX/Dumper.pm
index 553b1f19600c0585b5baca9277db06bd80afbf49..8be64be930cbda8f003d445c45a06be96e535fd0 100644 (file)
--- a/lib/File/KDBX/Dumper.pm
+++ b/lib/File/KDBX/Dumper.pm
@@ -169,36 +169,29 @@ sub dump_file {
     my $key = delete $args{key};
     $args{kdbx} //= $self->kdbx;
 
-    # require File::Temp;
-    # # my ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", CLEANUP => 1) };
-    # my $fh = eval { File::Temp->new(TEMPLATE => "${filepath}-XXXXXX", CLEANUP => 1) };
-    # my $filepath_temp = $fh->filename;
-    # if (!$fh or my $err = $@) {
-    #     $err //= 'Unknown error';
-    #     throw sprintf('Open file failed (%s): %s', $filepath_temp, $err),
-    #         error       => $err,
-    #         filepath    => $filepath_temp;
-    # }
-    open(my $fh, '>:raw', $filepath) or die "open failed ($filepath): $!";
-    binmode($fh);
-    # $fh->autoflush(1);
+    require File::Temp;
+    my ($fh, $filepath_temp) = eval { File::Temp::tempfile("${filepath}-XXXXXX", CLEANUP => 1) };
+    if (!$fh or my $err = $@) {
+        $err //= 'Unknown error';
+        throw sprintf('Open file failed (%s): %s', $filepath_temp, $err),
+            error       => $err,
+            filepath    => $filepath_temp;
+    }
+    $fh->autoflush(1);
 
     $self = $self->new if !ref $self;
     $self->init(%args, fh => $fh, filepath => $filepath);
-    # binmode($fh);
     $self->_dump($fh, $key);
+    close($fh);
 
-    # binmode($fh, ':raw');
-    # close($fh);
-
-    # my ($file_mode, $file_uid, $file_gid) = (stat($filepath))[2, 4, 5];
+    my ($file_mode, $file_uid, $file_gid) = (stat($filepath))[2, 4, 5];
 
-    # my $mode = $args{mode} // $file_mode // do { my $m = umask; defined $m ? oct(666) &~ $m : undef };
-    # my $uid  = $args{uid}  // $file_uid  // -1;
-    # my $gid  = $args{gid}  // $file_gid  // -1;
-    # chmod($mode, $filepath_temp) if defined $mode;
-    # chown($uid, $gid, $filepath_temp);
-    # rename($filepath_temp, $filepath) or throw "Failed to write file ($filepath): $!", filepath => $filepath;
+    my $mode = $args{mode} // $file_mode // do { my $m = umask; defined $m ? oct(666) &~ $m : undef };
+    my $uid  = $args{uid}  // $file_uid  // -1;
+    my $gid  = $args{gid}  // $file_gid  // -1;
+    chmod($mode, $filepath_temp) if defined $mode;
+    chown($uid, $gid, $filepath_temp);
+    rename($filepath_temp, $filepath) or throw "Failed to write file ($filepath): $!", filepath => $filepath;
 
     return $self;
 }
@@ -244,9 +237,38 @@ sub kdbx {
 
 =attr format
 
+Get the file format used for writing the database. Normally the format is auto-detected from the database,
+which is the safest choice. Possible formats:
+
+=for :list
+* C<V3>
+* C<V4>
+* C<KDB>
+* C<XML> (only used if explicitly set)
+* C<Raw> (only used if explicitly set)
+
+B<WARNING:> There is a potential for data loss if you explicitly use a format that doesn't support the
+features used by the KDBX database being written.
+
+The most common reason to explicitly specify the file format is to save a database as an unencrypted XML file:
+
+    $kdbx->dump_file('database.xml', format => 'XML');
+
 =cut
 
 sub format { $_[0]->{format} }
+
+=attr inner_format
+
+Get the format of the data inside the KDBX envelope. This only applies to C<V3> and C<V4> formats. Possible
+formats:
+
+=for :list
+* C<XML> - Write the database groups and entries as XML (default)
+* C<Raw> - Write L<File::KDBX/raw> instead of the actual database contents
+
+=cut
+
 sub inner_format { $_[0]->{inner_format} // 'XML' }
 
 =attr min_version
@@ -262,7 +284,29 @@ To generate older KDBX files unsupported by this module, try L<File::KeePass>.
 
 sub min_version { KDBX_VERSION_OLDEST }
 
-sub upgrade { $_[0]->{upgrade} // 1 }
+=attr allow_upgrade
+
+    $bool = $dumper->allow_upgrade;
+
+Whether or not to allow implicitly upgrading a database to a newer version. When enabled, in order to avoid
+potential data loss, the database can be upgraded as-needed in cases where the database file format version is
+too low to support new features being used.
+
+The default is to allow upgrading.
+
+=cut
+
+sub allow_upgrade { $_[0]->{allow_upgrade} // 1 }
+
+=attr randomize_seeds
+
+    $bool = $dumper->randomize_seeds;
+
+Whether or not to randomize seeds in a database before writing. The default is to randomize seeds, and there's
+not often a good reason not to do so. If disabled, the seeds associated with the KDBX database will be used as
+they are.
+
+=cut
 
 sub randomize_seeds { $_[0]->{randomize_seeds} // 1 }
 
@@ -276,7 +320,7 @@ sub _dump {
     my $kdbx = $self->kdbx;
 
     my $min_version = $kdbx->minimum_version;
-    if ($kdbx->version < $min_version && $self->upgrade) {
+    if ($kdbx->version < $min_version && $self->allow_upgrade) {
         alert sprintf("Implicitly upgrading database from %x to %x\n", $kdbx->version, $min_version),
             version => $kdbx->version, min_version => $min_version;
         $kdbx->version($min_version);