SL/DBUpgrade2.pm

   1 package SL::DBUpgrade2;
   2
   3 require Exporter;
   4 @ISA = qw(Exporter);
   5
   6 @EXPORT = qw(parse_dbupdate_controls sort_dbupdate_controls);
   7
   8 sub parse_dbupdate_controls {
   9   $main::lxdebug->enter_sub();
  10
  11   my ($form, $dbdriver) = @_;
  12
  13   my $locale = $main::locale;
  14
  15   local *IN;
  16   my %all_controls;
  17
  18   my $path = "sql/${dbdriver}-upgrade2";
  19
  20   foreach my $file_name (<$path/*.sql>, <$path/*.pl>) {
  21     next unless (open(IN, $file_name));
  22
  23     my $file = $file_name;
  24     $file =~ s|.*/||;
  25
  26     my $control = {
  27       "priority" => 1000,
  28       "depends" => [],
  29     };
  30
  31     while (<IN>) {
  32       chomp();
  33       next unless (/^(--|\#)\s*\@/);
  34       s/^(--|\#)\s*\@//;
  35       s/\s*$//;
  36       next if ($_ eq "");
  37
  38       my @fields = split(/\s*:\s*/, $_, 2);
  39       next unless (scalar(@fields) == 2);
  40
  41       if ($fields[0] eq "depends") {
  42         push(@{$control->{"depends"}}, split(/\s+/, $fields[1]));
  43       } else {
  44         $control->{$fields[0]} = $fields[1];
  45       }
  46     }
  47
  48     _control_error($form, $file_name,
  49                    $locale->text("Missing 'tag' field."))
  50       unless ($control->{"tag"});
  51
  52     _control_error($form, $file_name,
  53                    $locale->text("The 'tag' field must only consist of " .
  54                                  "alphanumeric characters or the carachters " .
  55                                  "- _ ( )"))
  56       if ($control->{"tag"} =~ /[^a-zA-Z0-9_\(\)\-]/);
  57
  58     _control_error($form, $file_name,
  59                    sprintf($locale->text("More than one control file " .
  60                                          "with the tag '%s' exist."),
  61                            $control->{"tag"}))
  62       if (defined($all_controls{$control->{"tag"}}));
  63
  64     _control_error($form, $file_name,
  65                    sprintf($locale->text("Missing 'description' field.")))
  66       unless ($control->{"description"});
  67
  68     $control->{"priority"} *= 1;
  69     $control->{"priority"} = 1000 unless ($control->{"priority"});
  70
  71     $control->{"file"} = $file;
  72
  73     map({ delete($control->{$_}); } qw(depth applied));
  74
  75     $all_controls{$control->{"tag"}} = $control;
  76
  77     close(IN);
  78   }
  79
  80   foreach my $control (values(%all_controls)) {
  81     foreach my $dependency (@{$control->{"depends"}}) {
  82       _control_error($form, $control->{"file"},
  83                      sprintf($locale->text("Unknown dependency '%s'."),
  84                              $dependency))
  85         if (!defined($all_controls{$dependency}));
  86     }
  87
  88     map({ $_->{"loop"} = 0; } values(%all_controls));
  89     _check_for_loops($form, $control->{"file"}, \%all_controls,
  90                      $control->{"tag"});
  91   }
  92
  93   map({ _dbupdate2_calculate_depth(\%all_controls, $_->{"tag"}) }
  94       values(%all_controls));
  95
  96   $main::lxdebug->leave_sub();
  97
  98   return \%all_controls;
  99 }
 100
 101 sub _check_for_loops {
 102   my ($form, $file_name, $controls, $tag, @path) = @_;
 103
 104   push(@path, $tag);
 105
 106   my $ctrl = $controls->{$tag};
 107
 108   if ($ctrl->{"loop"} == 1) {
 109     # Not done yet.
 110     _control_error($form, $file_name,
 111                    $main::locale->text("Dependency loop detected:") .
 112                    " " . join(" -> ", @path))
 113   } elsif ($ctrl->{"loop"} == 0) {
 114     # Not checked yet.
 115     $ctrl->{"loop"} = 1;
 116     map({ _check_for_loops($form, $file_name, $controls, $_, @path); }
 117         @{ $ctrl->{"depends"} });
 118     $ctrl->{"loop"} = 2;
 119   }
 120 }
 121
 122 sub _control_error {
 123   my ($form, $file_name, $message) = @_;
 124
 125   my $form = $main::form;
 126   my $locale = $main::locale;
 127
 128   $form->error(sprintf($locale->text("Error in database control file '%s': %s"),
 129                        $file_name, $message));
 130 }
 131
 132 sub _dbupdate2_calculate_depth {
 133   $main::lxdebug->enter_sub();
 134
 135   my ($tree, $tag) = @_;
 136
 137   my $node = $tree->{$tag};
 138
 139   return $main::lxdebug->leave_sub() if (defined($node->{"depth"}));
 140
 141   my $max_depth = 0;
 142
 143   foreach $tag (@{$node->{"depends"}}) {
 144     _dbupdate2_calculate_depth($tree, $tag);
 145     my $value = $tree->{$tag}->{"depth"};
 146     $max_depth = $value if ($value > $max_depth);
 147   }
 148
 149   $node->{"depth"} = $max_depth + 1;
 150
 151   $main::lxdebug->leave_sub();
 152 }
 153
 154 sub sort_dbupdate_controls {
 155   return
 156     sort({ $a->{"depth"} != $b->{"depth"} ? $a->{"depth"} <=> $b->{"depth"} :
 157              $a->{"priority"} != $b->{"priority"} ?
 158              $a->{"priority"} <=> $b->{"priority"} :
 159              $a->{"tag"} cmp $b->{"tag"} } values(%{$_[0]}));
 160 }
 161
 162
 163 1;