Improving version history.

We already had support for read.

lib/GEmeTool/DB/Migrations.pm

@@ -23,6 +23,13 @@ sub MIGRATIONS {
             backup_input_file TEXT,
             backup_output_file TEXT
         );',
+        'CREATE TABLE backups_pk3 (
+            uuid TEXT PRIMARY KEY,
+            date datetime NOT NULL,
+            nickname TEXT,
+            pokemon_name TEXT,
+            file TEXT
+        );',
     );
 }
 1;

lib/GEmeTool/Log.pm

@@ -29,6 +29,7 @@ sub msg {
     my $msg         = shift;
     my $input_file  = shift;
     my $output_file = shift;
+    my $backup_pk3_file = shift;
     my ( $input_file_backup, $output_file_backup ) =
       $self->backup_files( $input_file, $output_file );
     my $db     = GEmeTool::DB->connect;
@@ -74,6 +75,8 @@ sub backup_files {
             next;
         }
         my $basename    = $file->basename;
+        $basename =~ s/\.\.//g;
+        $basename =~ s/\///g;
         my $output_file = $backup_dir->child("$digest-$basename");
         $output_file->spew_raw($contents);
         push @result_files, $output_file;

lib/GEmeTool/Save/Pokemon.pm

@@ -5,12 +5,20 @@ use v5.16.3;
 use strict;
 use warnings;
 
+use Data::Dumper;
+
 use Moo;
 use Rsaves;
 use Rsaves::Constants::Emerald::Species;
 use Rsaves::Constants::Emerald::SpeciesData;
+use Path::Tiny;
+use GEmeTool::DB;
+use GEmeTool::Config;
+use Digest::SHA   qw/sha256_hex/;
+use Digest::SHA qw/sha256_hex/;
+use UUID::URandom qw/create_uuid_string/;
 
-has _pokemon => ( is => 'rw', );
+has _pokemon => ( is => 'rw', required => 1 );
 
 sub species {
     my $self        = shift;
@@ -23,9 +31,41 @@ sub species {
     return $substruct_0->{species};
 }
 
+sub load_from_file {
+    my $class = shift;
+    my $file  = shift;
+    $file = path($file);
+    die 'No such plain file' if !-f $file;
+    return $class->new( _pokemon => Rsaves::read_pk3_file($file) );
+}
+
+sub export_file {
+    my $self = shift;
+    my $file = shift;
+    Rsaves::write_pk3_file( $self->_pokemon, $file );
+}
+
+sub export_raw {
+    my $self        = shift;
+    return Rsaves::get_pk3_raw($self->_pokemon);
+}
+
+sub empty {
+    my $class = shift;
+    return $class->new( _pokemon => Rsaves::read_pk3_raw( "\0" x 0x80 ) );
+}
+
+sub copy {
+    my $self                = shift;
+    my $object_to_copy_from = shift;
+    %{ $self->_pokemon } = %{ $object_to_copy_from->_pokemon };
+    return $self;
+}
+
 sub ivs {
     my $self = shift;
     my $arg  = shift;
+    print Data::Dumper::Dumper $self->_pokemon;
     my $current_value =
       $self->_pokemon->{substructures}[3]{ivs_egg_status_and_ability};
     my @stats = (
@@ -111,6 +151,7 @@ sub level {
     my $self    = shift;
     my $arg     = shift;
     my $pokemon = $self->_pokemon;
+    return 0 if $self->species == 0;
     my $growth_func = sub {
         my $n = shift;
         if ( $n == 1 ) {
@@ -356,4 +397,40 @@ sub get_front {
     }
     return "pokeemerald/graphics/pokemon/@{[lc($pokemon_name)]}/front.png";
 }
+
+sub backup {
+    my $self       = shift;
+    my $db         = GEmeTool::DB->connect;
+    my $data_dir   = GEmeTool::Config->new->data_dir;
+    my $backup_dir = $data_dir->child('backups/pk3');
+    $backup_dir->mkpath;
+    my $nickname = Rsaves::translate_3rd_encoding( $self->nickname );
+    $nickname =~ s/\.\.//g;
+    $nickname =~ s/\///g;
+    my $contents = $self->export_raw;
+    my $digest   = sha256_hex($contents);
+    my $file     = $backup_dir->child(
+        $nickname . '-' . $self->pokemon_name . '-' . $digest . '.pk3' )
+      ->absolute;
+    $file->spew_raw($contents);
+    my $uuid               = create_uuid_string();
+    my $query_check_exists = <<'EOF';
+SELECT file FROM backups_pk3
+WHERE file = ?
+EOF
+
+    if ( $db->selectrow_hashref( $query_check_exists, undef, $file ) ) {
+        $db->do( <<'EOF', undef, $file );
+UPDATE backups_pk3
+SET date=datetime('now')
+WHERE file = ?;
+EOF
+        return;
+    }
+    my $query = <<'EOF';
+INSERT INTO backups_pk3 (uuid, date, nickname, pokemon_name, file)
+VALUES (?, datetime('now'), ?, ?, ?);
+EOF
+    $db->do( $query, {}, $uuid, $self->nickname, $self->pokemon_name, $file );
+}
 1;

lib/GEmeTool/View/PokemonEditorWindow.pm

@@ -15,6 +15,9 @@ use Path::Tiny;
 use Rsaves;
 use Rsaves::Constants::Emerald::Species;
 use Rsaves::Constants::Emerald::Natures;
+use GEmeTool::Save::Pokemon;
+use GEmeTool::Options;
+use GEmeTool::DB;
 
 Glib::Object::Introspection->setup(
     basename => 'Gtk',
@@ -98,7 +101,11 @@ sub draw {
     $grid->attach( $canvas, 0, 0, 2, 2 );
     my @species        = (@Rsaves::Constants::Emerald::Species::SPECIES);
     my $string_list    = Gtk4::StringList->new( [@species] );
+    my $restore_button = Gtk4::Button->new_with_label('Restore from backup');
     my $save_button    = Gtk4::Button->new_with_label('Save changes');
+    my $delete_button  = Gtk4::Button->new_with_label('Delete pokemon');
+    my $import_button  = Gtk4::Button->new_with_label('Import .pk3');
+    my $export_button  = Gtk4::Button->new_with_label('Export .pk3');
     $self->_selected_species( $pokemon->species );
     my $box_right_image = Gtk4::Box->new( 'vertical', 1 );
     $box_right_image->set_margin_top(30);
@@ -113,6 +120,90 @@ sub draw {
     $self->create_change_nickname_entry($box_right_image);
     $save_button->signal_connect(
         clicked => sub {
+            $self->activate_save;
+        }
+    );
+    $delete_button->signal_connect(
+        clicked => sub {
+            $self->delete;
+        }
+    );
+    $import_button->signal_connect(
+        clicked => sub {
+            $self->activate_import_pk3;
+        }
+    );
+    $export_button->signal_connect(
+        clicked => sub {
+            $self->activate_export_pk3;
+        }
+    );
+    $restore_button->signal_connect(
+        clicked => sub {
+            $self->activate_restore;
+        }
+    );
+    $self->draw_dropdown_pokemon_list($box_right_image);
+    my $box_label_iv = Gtk4::Box->new( 'horizontal', 10 );
+    $box_label_iv->append( Gtk4::Label->new('Select IV') );
+    $box_right_image->append($box_label_iv);
+    $self->create_select_ivs($box_right_image);
+    $self->create_modify_personality($grid);
+    $grid->attach( $save_button,    4, 7, 1, 1 );
+    $grid->attach( $export_button,  3, 7, 1, 1 );
+    $grid->attach( $delete_button,  2, 7, 1, 1 );
+    $grid->attach( $import_button,  1, 7, 1, 1 );
+    $grid->attach( $restore_button, 0, 7, 1, 1 );
+    $window->set_child($grid);
+}
+
+sub activate_restore {
+    my $self   = shift;
+    my $window = Gtk4::Window->new;
+    $window->set_title('Restore from backup');
+    my $scroll  = Gtk4::ScrolledWindow->new;
+    my $grid    = Gtk4::Grid->new;
+    my $backups = $self->get_backups;
+    my $i       = 0;
+    for my $backup (@$backups) {
+        my $nickname = Rsaves::translate_3rd_encoding( $backup->{nickname} );
+        my $pokemon_name = $backup->{pokemon_name};
+        my $file         = $backup->{file};
+        my $button =
+          Gtk4::Button->new_with_label( $nickname . '-' . $pokemon_name );
+        $button->signal_connect(
+            clicked => sub {
+                $self->activate_save;
+                $self->pokemon->backup;
+                $self->pokemon->copy(
+                    GEmeTool::Save::Pokemon->load_from_file($file) );
+                $self->draw;
+                $window->close;
+            }
+        );
+        $grid->attach( $button, $i % 6, int( $i / 6 ), 1, 1 );
+        $i++;
+    }
+    $window->set_child($grid);
+    $window->present;
+}
+
+sub get_backups {
+    my $self  = shift;
+    my $db    = GEmeTool::DB->connect;
+    my $query = <<'EOF';
+SELECT nickname, pokemon_name, file
+FROM backups_pk3
+ORDER BY date DESC;
+EOF
+    my $result = $db->selectall_arrayref( $query, { Slice => {} } );
+    return $result;
+}
+
+sub activate_save {
+    my $self    = shift;
+    my $pokemon = $self->pokemon;
+    $pokemon->backup;
     $pokemon->species( $self->_selected_species );
     $pokemon->personality( $self->_current_personality );
     $self->recalculate_ivs;
@@ -120,15 +211,75 @@ sub draw {
     for my $func ( @{ $self->_save_callbacks } ) {
         $func->();
     }
+    $pokemon->backup;
+    $self->draw;
+}
+
+sub activate_export_pk3 {
+    my $self     = shift;
+    my $win      = $self->_win;
+    my $dialog   = Gtk4::FileDialog->new;
+    my $options  = GEmeTool::Options->new;
+    my $last_dir = $options->get_last_dir_open;
+    if ( defined $last_dir && -d $last_dir ) {
+        my $curdir = Glib::IO::File::new_for_path($last_dir);
+        $dialog->set_initial_folder($curdir);
+        $dialog->set_initial_name(
+                Rsaves::translate_3rd_encoding( $self->pokemon->nickname ) . '-'
+              . $self->pokemon->pokemon_name
+              . '.pk3' );
+    }
+    $dialog->save(
+        $win, undef,
+        sub {
+            my ( $self_dialog, $res ) = @_;
+            if ( $res->had_error ) {
+                return;
+            }
+            my $file = $dialog->save_finish($res);
+            return if !defined $file;
+            $file = path( $file->get_path );
+            $self->pokemon->export_file($file);
+        }
+    );
+}
+
+sub delete {
+    my $self = shift;
+    $self->pokemon->backup;
+    $self->pokemon->copy( GEmeTool::Save::Pokemon->empty );
+    $self->draw;
+}
+
+sub activate_import_pk3 {
+    my $self        = shift;
+    my $cancellable = Glib::IO::Cancellable->new;
+    my $dialog      = Gtk4::FileDialog->new;
+    my $win         = $self->_win;
+    my $options     = GEmeTool::Options->new;
+    my $last_dir    = $options->get_last_dir_open;
+    if ( defined $last_dir && -d $last_dir ) {
+        my $curdir = Glib::IO::File::new_for_path($last_dir);
+        $dialog->set_initial_folder($curdir);
+    }
+    $dialog->open(
+        $win,
+        $cancellable,
+        sub {
+            my ( $self_dialog, $res ) = @_;
+            if ( $res->had_error ) {
+                return;
+            }
+            my $file = $dialog->open_finish($res);
+            return if !defined $file;
+            $file = path( $file->get_path );
+            $options->set_last_dir_open( $file->parent . '' );
+            $self->activate_save;
+            $self->pokemon->copy(
+                GEmeTool::Save::Pokemon->load_from_file($file) );
             $self->draw;
         }
     );
-    $self->draw_dropdown_pokemon_list($box_right_image);
-    $box_right_image->append(Gtk4::Label->new('Select IV'));
-    $self->create_select_ivs($box_right_image);
-    $self->create_modify_personality($grid);
-    $grid->attach( $save_button, 4, 7, 1, 1 );
-    $window->set_child($grid);
 }
 
 sub create_select_level {
@@ -141,7 +292,8 @@ sub create_select_level {
     $entry->set_input_purpose('digits');
     $entry->get_buffer->set_text( $pokemon->level, length $pokemon->level );
     $box_level->append($entry);
-    $self->onSave( sub {
+    $self->onSave(
+        sub {
             my $text = $entry->get_buffer->get_text;
             if ( $text !~ /^[0-9]+$/ ) {
                 return;
@@ -153,7 +305,8 @@ sub create_select_level {
                 $text = 2;
             }
             $pokemon->level($text);
-    });
+        }
+    );
     $box->append($box_level);
 }
 

lib/Rsaves.pm

@@ -29,7 +29,7 @@ our @EXPORT_OK = (
     qw/read_pc_storage save_pc_changes save_changes enable_eon_ticket
       add_key_item set_flag_id change_gender read_save get_saves
       find_current_save_index check_correct_size find_pokemon_substruct
-      read_pkm_file_box calculate_shiny_personality pokemon_set_shiny
+      calculate_shiny_personality pokemon_set_shiny
       get_first_super_data set_first_super_data enable_rematch_main_legendary
       check_flag_id enable_mirage_island_for_pokemon parse_version_name
       enable_deoxys_firered match_again_rival_firered_cerulean pokemon_fill_pp to_3rd_encoding translate_3rd_encoding check_rematch/
@@ -264,7 +264,7 @@ sub _read_pokemon_boxes_from_fh {
         for my $j ( 0 .. 29 ) {
             read $fh, my $pokemon_data, 0x50 or die "Failed to read 0x50 bytes";
             open my $pokemon_fh, '<', \$pokemon_data;
-            push @$box, _read_pokemon_box_from_fh($pokemon_fh);
+            push @$box, _read_pokemon_from_fh($pokemon_fh);
             close $pokemon_fh;
         }
         push @$boxes, $box;
@@ -272,18 +272,41 @@ sub _read_pokemon_boxes_from_fh {
     return $boxes;
 }
 
-sub read_pkm_file_box {
+sub read_pk3_file {
     my $file = shift;
     open my $fh, '<', $file or die "Unable to open $file";
     my $file_contents = join '', <$fh>;
-    $file_contents = substr $file_contents, 0, 0x50;
-    open $fh, '<', \$file_contents;
-    return _read_pokemon_box_from_fh( $fh, 1 );
+    return read_pk3_raw($file_contents);
+}
+
+sub read_pk3_raw {
+    my $raw = shift;
+    $raw = substr $raw, 0, 0x50;
+    open my $fh, '<', \$raw;
+    return _read_pokemon_from_fh( $fh, 1 );
+}
+
+sub get_pk3_raw {
+    my $pokemon = shift;
+    my $return  = '';
+    open my $fh, '>', \$return;
+    _write_pokemon_fh( $fh, $pokemon, 1 );
+    close $fh;
+    return $return;
+}
+
+sub write_pk3_file {
+    my $pokemon = shift;
+    my $file = shift;
+    my $content = get_pk3_raw($pokemon);
+    open my $fh, '>', $file or return;
+    print $fh $content;
 }
 
 sub _write_pokemon_fh {
     my $fh          = shift;
     my $pokemon     = shift;
+    my $is_pkm_file = shift;
     if ( $pokemon->{personality} > 0xFFFFFFFF ) {
         die "Too big personality";
     }
@@ -307,8 +330,10 @@ sub _write_pokemon_fh {
     {
         open my $fh_substructures, '>', \$substructures_raw;
         $pokemon->{checksum} = _write_pokemon_substructures_fh(
-            $fh_substructures,       $pokemon->{substructures},
-            $pokemon->{personality}, $pokemon->{otid}
+            $fh_substructures,
+            $pokemon->{substructures},
+            $pokemon->{personality},
+            $pokemon->{otid}, $is_pkm_file, 
         );
         close $fh_substructures;
     }
@@ -320,7 +345,7 @@ sub _write_pokemon_fh {
     print $fh $substructures_raw;
 }
 
-sub _read_pokemon_box_from_fh {
+sub _read_pokemon_from_fh {
     my $fh          = shift;
     my $is_pkm_file = shift;
 
@@ -406,10 +431,14 @@ sub _write_pokemon_substructures_fh {
     my $substructures           = shift;
     my $personality             = shift;
     my $otid                    = shift;
+    my $is_pkm_file             = shift;
     my $modulo                  = $personality % 24;
     my $decrypted_substructures = '';
     open my $fh_decrypted_substructures, '>', \$decrypted_substructures;
-    my @order_substructures = _pokemon_substructures_order_by_modulo($modulo);
+    my @order_substructures =
+      ( $is_pkm_file
+        ? ( 0 .. 3 )
+        : _pokemon_substructures_order_by_modulo($modulo) );
 
     my $substruct0 = find_pokemon_substruct( $substructures, 0 );
 
@@ -430,14 +459,20 @@ sub _write_pokemon_substructures_fh {
     seek $fh_decrypted_substructures, 0, 0;
     my $encrypted_substructures;
     open my $fh_encrypted_substructures, '>', \$encrypted_substructures;
+    if (!$is_pkm_file) {
         for ( 0 .. 11 ) {
             read $fh_decrypted_substructures, my $read, 4;
             $read = pack 'V', ( ( ( unpack 'V', $read ) ^ $personality ) ^ $otid );
             print $fh_encrypted_substructures $read;
         }
+    }
     close $fh_decrypted_substructures;
     close $fh_encrypted_substructures;
+    if ($is_pkm_file) {
+        print $fh $decrypted_substructures;
+    } else {
         print $fh $encrypted_substructures;
+    }
     return $checksum;
 }