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   _control_error($form, $file_name,
 107                  $main::locale->text("Dependency loop detected:") .
 108                  " " . join(" -> ", @path))
 109     if ($controls->{$tag}->{"loop"});
 110
 111   $controls->{$tag}->{"loop"} = 1;
 112   map({ _check_for_loops($form, $file_name, $controls, $_, @path); }
 113       @{$controls->{$tag}->{"depends"}});
 114 }
 115
 116 sub _control_error {
 117   my ($form, $file_name, $message) = @_;
 118
 119   my $form = $main::form;
 120   my $locale = $main::locale;
 121
 122   $form->error(sprintf($locale->text("Error in database control file '%s': %s"),
 123                        $file_name, $message));
 124 }
 125
 126 sub _dbupdate2_calculate_depth {
 127   $main::lxdebug->enter_sub();
 128
 129   my ($tree, $tag) = @_;
 130
 131   my $node = $tree->{$tag};
 132
 133   return $main::lxdebug->leave_sub() if (defined($node->{"depth"}));
 134
 135   my $max_depth = 0;
 136
 137   foreach $tag (@{$node->{"depends"}}) {
 138     _dbupdate2_calculate_depth($tree, $tag);
 139     my $value = $tree->{$tag}->{"depth"};
 140     $max_depth = $value if ($value > $max_depth);
 141   }
 142
 143   $node->{"depth"} = $max_depth + 1;
 144
 145   $main::lxdebug->leave_sub();
 146 }
 147
 148 sub sort_dbupdate_controls {
 149   return
 150     sort({ $a->{"depth"} != $b->{"depth"} ? $a->{"depth"} <=> $b->{"depth"} :
 151              $a->{"priority"} != $b->{"priority"} ?
 152              $a->{"priority"} <=> $b->{"priority"} :
 153              $a->{"tag"} cmp $b->{"tag"} } values(%{$_[0]}));
 154 }
 155
 156
 157 1;