[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]
[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]
[output name=""]
[/if]
@_UI_STD_FOOTER_@