1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
# Copyright (c) 1997-2024
# Ewgenij Gawrilow, Michael Joswig, and the polymake team
# Technische Universität Berlin, Germany
# https://polymake.org
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 2, or (at your option) any
# later version: http://www.gnu.org/licenses/gpl.txt.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#-------------------------------------------------------------------------------
use strict;
use namespaces;
use warnings qw(FATAL void syntax misc);
use feature 'state';
require Polymake::Core::UpgradeRule;
require Polymake::Core::UpgradeGroup;
package Polymake::Core::Upgrades;
my $cur_loading;
use Polymake::Struct (
[ new => '$' ],
[ '$to_version' => '#1' ],
[ '$to_v' => 'eval("v" . #1)' ],
'@groups',
);
sub prepare {
my ($self, $expect_complete) = @_;
local scalar $cur_loading = $self;
dbg_print( "reading upgrade rules from $InstallTop/upgrades/".$self->to_version ) if $Verbose::rules > 1;
do "upgrades/".$self->to_version;
if ($@) {
die "failed to load upgrade rules for ", $self->to_version, ": $@";
}
if ($expect_complete && !@{$self->groups}) {
die "upgrade file $InstallTop/upgrades/" . $self->to_version . " does not define any rules\n";
}
# assign big object inventories to groups
# versions without own inventories are assumed to share it with their predecessors
my $big_objects;
foreach my $group (reverse @{$self->groups}) {
my $inv_file = "$InstallTop/upgrades/big_objects-".$group->to_version;
if (-f $inv_file) {
open my $F, $inv_file
or die "can't read inventory file $inv_file: $!\n";
local $/;
$big_objects = decode_json(<$F>);
is_hash($big_objects->{descend}) &&
is_hash($big_objects->{super})
or die "invalid inventory file $inv_file: missing mandatory elements 'descend' and/or 'super'\n";
}
$group->big_objects = $big_objects;
if ($expect_complete) {
defined($big_objects)
or die "missing inventory file $inv_file\n";
$group->prepare;
}
}
}
sub add_rule {
my ($to_version, $to_v, $type, $paths, $body) = @_;
if ($to_v ge $cur_loading->to_v) {
croak("target version of an upgrade rule $to_version is higher than the target version of the entire rule file ", $cur_loading->to_version);
}
my $rule = new UpgradeRule($type, $paths, $body);
my $self = $cur_loading;
# insert rules in descending version order
for (my ($i, $last) = (0, $#{$self->groups}); $i <= $last; ++$i) {
my $group = $self->groups->[$i];
my $cmp_versions = $group->to_v cmp $to_v;
if ($cmp_versions < 0) {
$group = new UpgradeGroup($to_version, $to_v);
splice @{$self->groups}, $i, 0, $group;
}
if ($cmp_versions <= 0) {
push @{$group->rules}, $rule;
return;
}
}
my $group = new UpgradeGroup($to_version, $to_v);
push @{$self->groups}, $group;
push @{$group->rules}, $rule;
}
my @repo;
sub get_groups {
my ($from_version) = @_;
unless (@repo) {
@repo = sort { $b->to_v cmp $a->to_v } map { m{/([\d.]+)$} ? new(__PACKAGE__, $1) : () } glob("$InstallTop/upgrades/*");
}
my $index = -1;
foreach my $updates (@repo) {
last if $updates->to_v le $from_version;
unless (@{$updates->groups}) {
prepare($updates, true);
}
++$index;
}
reverse((map { @{$repo[$_]->groups} } 0..$index-1),
$index >= 0 ? (grep { $_->to_v gt $from_version } @{$repo[$index]->groups}) : ());
}
sub apply {
my ($obj, $version, $default_type) = @_;
my $cnt = 0;
foreach my $group (get_groups($version)) {
$cnt += $group->apply($obj, $default_type);
}
$cnt
}
1
# Local Variables:
# cperl-indent-level:3
# indent-tabs-mode:nil
# End:
|
