[flag type=write table="__UI_META_TABLE__"] [flag type=write table="mv_metadata"] [tmp page_title][L]Merge Metadata[/L][/tmp] [set ui_class]Misc[/set] [tmp help_name]mergemeta.main[/tmp] [tmp icon_name]icon_config.gif[/tmp] @_UI_STD_HEAD_@ [perl tables="__UI_META_TABLE__ mv_metadata"] delete $Scratch->{merge_complete}; delete $Scratch->{do_merge}; my $tab = q{__UI_META_TABLE__} || 'mv_metadata'; my $db = $Db{$tab} or do { $Scratch->{merge_complete} = errmsg("Cannot merge: no meta table '%s'", $tab); return; }; my $newver = $Tag->version(); $Scratch->{newver} = $newver; my $compnew = $newver; $compnew =~ s/\D+//g; my $curver = '4.8.7'; if ($db->record_exists('ui-version')) { $curver = $db->field("ui-version", 'label'); } $Scratch->{curver} = $curver; my $compcur = $curver; $compcur =~ s/\D+//g; if ($curver eq $newver) { $Scratch->{merge_complete} = errmsg("Already merged to current version %s.", $curver); } elsif($compcur gt $compnew) { $Scratch->{merge_complete} = errmsg("Already merged to higher version %s.", $curver); } if($CGI->{force} or $CGI->{merge_key}) { $Scratch->{merge_anyway} = delete $Scratch->{merge_complete}; } return; [/perl]
[if scratch merge_complete]

> [scratch merge_complete]
> [tmp new_url][area href="@@MV_PAGE@@" form="force=1"][/tmp]

[tmpn do_merge][/tmpn] [elsif scratch merge_anyway]

> [scratchd merge_anyway]
> [L]Merging anyway.[/L]

[tmpn do_merge]1[/tmpn] [/elsif] [else] [tmpn do_merge]1[/tmpn] [/else] [/if] [if scratch do_merge]

[msg arg.0="[scratch newver]" arg.1="[scratch curver]"]Merge run, UI version %s, metadata version %s[/msg]
  [perl tables="__UI_META_TABLE__ mv_metadata"] my $fn = 'include/meta/mv_metadata.asc'; my $metatxt = $Tag->file($fn); $Tag->write_relative_file($fn, $metatxt); sub diff_array { my ($ary1, $ary2) = @_; return 0 if ref($ary1) ne ref($ary2); return 0 if ref($ary1) ne 'ARRAY'; return 0 if scalar(@$ary1) != scalar(@$ary2); for(my $i = 0; $i < scalar(@$ary1); $i++) { if(! ref($ary1->[$i])) { return 0 if $ary1->[$i] ne $ary2->[$i]; } elsif(ref($ary1->[$i]) eq 'ARRAY') { diff_array($ary1->[$i], $ary2->[$i]) or return 0; } else { diff_hash($ary1->[$i], $ary2->[$i]) or return 0; } } return 1; } sub diff_hash { my($hash1, $hash2) = @_; my(@keys1) = sort keys %$hash1; my(@keys2) = sort keys %$hash2; if (scalar(@keys1) != scalar(@keys2) ) { ## Differing number of keys return 0; } for(@keys1) { if(! ref($hash1->{$_})) { return 0 if $hash1->{$_} ne $hash2->{$_}; } elsif(ref($hash1->{$_}) eq 'ARRAY') { diff_array($hash1->{$_}, $hash2->{$_}) or return 0; } else { diff_hash($hash1->{$_}, $hash2->{$_}) or return 0; } } return 1; } sub check_merge { my($hash1, $hash2) = @_; my $ext2 = get_option_hash($hash2->{extended}); return 1 if $ext2->{ui_version} eq $Scratch->{newver} and ! $CGI->{force}; my $ext1 = get_option_hash($hash1->{extended}); $hash1->{extended} = $ext1; $hash2->{extended} = $ext2; return diff_hash($hash1, $hash2); } return; [/perl] [perl tables="__UI_META_TABLE__ mv_metadata_asc mv_metadata"] my $bdb = $Db{mv_metadata_asc}; my $mtab = q{__UI_META_TABLE__} || 'mv_metadata'; my $mdb = $Db{$mtab}; if(! $bdb) { $Scratch->{merge_error} = errmsg("Cannot merge metadata -- table %s is missing.", 'mv_metadata_asc'); return; } if(! $mdb) { $Scratch->{merge_error} = errmsg("Cannot merge metadata -- table %s is missing.", $mtab); return; } my @needcols = qw(extended); if(@needcols = grep {! $mdb->column_exists($_)} @needcols) { $Scratch->{merge_error} = errmsg("Cannot merge metadata -- column(s) '%s' is missing in table %s.", join(',', @needcols), $mtab); return; } my @base; while( my ($k) = $bdb->each_record()) { push @base, $k; } my %merge; if($CGI->{merge_key}) { my @keys = split /\0/, $CGI->{merge_key}; my @status = split /\0/, $CGI->{merge_status}; for(my $i = 0; $i < @keys; $i++) { $merge{$keys[$i]} = $status[$i]; } } $Scratch->{merge_updated} = 0; $Scratch->{merge_complete} = 0; $Scratch->{merge_needed} = 0; %source = (); %target = (); for(@base) { my $source = $bdb->row_hash($_); my $target = $mdb->row_hash($_); if(! $target or $merge{$_} == 1) { my $ext = get_option_hash($source->{extended}); $ext->{ui_version} = $Scratch->{newver}; $source->{extended} = uneval($ext); my $code = delete $source->{code}; $mdb->set_slice($code, $source); $Scratch->{merge_updated}++; } elsif($merge{$_} == -1) { my $ext = get_option_hash($target->{extended}); $ext->{ui_version} = $Scratch->{newver}; $target->{extended} = uneval($ext); my $code = delete $target->{code}; $mdb->set_slice($code, $target); $Scratch->{merge_updated}++; } elsif( check_merge($source, $target) ) { $Scratch->{merge_complete}++; } else { $Scratch->{merge_needed}++; $source{$_} = $source; $target{$_} = $target; } } if($Scratch->{merge_needed} == 0) { $mdb->set_field('ui-version', 'label', $Scratch->{newver}); } return; [/perl] [if scratch merge_error]

  > [scratchd merge_error]

  [else]
  - [L]Entries merged:[/L] [scratch merge_updated]
  - [L]No merge needed:[/L] [scratch merge_complete]
  - [L]Merge still needed:[/L] [scratch merge_needed]
  [/else] [/if]
[L]Items to merge[/L]
[output name=top_of_form] [form-session-id] [output name=""]

[perl] my @out; my $rid = 0; for my $code (sort keys %source) { my @rec = <
$code | [L]Defer all[/L] [L]Merge all[/L] [L]Keep all[/L] [L]Toggle showing identical keys[/L]
[L]key[/L] | [L]new version[/L] | [L]old version[/L]
EOF my %seen; my $s = $source{$code}; my $t = $target{$code}; my $e1 = get_option_hash(delete $s->{extended}); my $e2 = get_option_hash(delete $t->{extended}); my @keys = grep !$seen{$_}++, keys %$s, keys %$t; @keys = grep length($s->{$_}) || length($t->{$_}), @keys; my $i = 0; sub display_string { my $val = shift; $val =~ s/\s+$//; $val =~ s/^\s+//; $val =~ s/\r\n/\n/g; $val =~ s/\r/\n/g; $val = $Tag->filter('entities', $val); $val =~ s/\n/
/g; $val =~ s/,/,
/g; return $val; } for my $one ( @keys ) { next if $one eq 'code'; my $id = $s->{$one} eq $t->{$one}; my $val1 = display_string($s->{$one}); my $val2 = display_string($t->{$one}); my $sid = $val1 eq $val2; my $status; my $style = ''; my $trid = ''; my $extra = ''; if($id) { $style = 'Display: none'; $status = ' (identical)'; $trid = 'identical_key' . $rid++; } elsif ($sid) { $status = ' (different whitespace)'; $extra = qq{ style="color: green"}; } else { $status = ''; $extra = qq{ style="color: red"}; } $val1 = ' ' if ! length ($val1); $val2 = ' ' if ! length ($val2); push @rec, < |
$one$status | $val1 | $val2
EOF } @keys = grep !$seen{$_}++, keys %$e1, keys %$e2; @keys = grep length($e1->{$_}) || length($e2->{$_}), @keys; $i = 0; for my $one ( @keys ) { my $id = $e1->{$one} eq $e2->{$one}; my $val1 = display_string($e1->{$one}); my $val2 = display_string($e2->{$one}); my $sid = $val1 eq $val2; my $status; my $style = ''; my $trid = ''; my $extra = ''; if($id) { $style = 'Display: none'; $status = ' (identical)'; $trid = 'identical_key' . $rid++; } elsif ($sid) { $status = ' (different whitespace)'; $extra = qq{ style="color: green"}; } else { $status = ''; $extra = qq{ style="color: red"}; } $val1 = ' ' if ! length ($val1); $val2 = ' ' if ! length ($val2); push @rec, < |
$one$status | $val1 | $val2
EOF } push @rec, "
"; push @out, join "\n", @rec; } return join "", @out; [/perl]

[output name=bottom_buttons] [output name=top_buttons] [output name=bottom_of_form] [output name=""]

[/if] @_UI_STD_FOOTER_@