scripts/migrate_menu.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use SL::Dispatcher;
   5 use SL::Inifile;
   6 use SL::LXDebug;
   7 use Data::Dumper;
   8 use JSON;
   9 use YAML;
  10 use Cwd;
  11
  12 $::lxdebug = LXDebug->new;
  13
  14 my %menu_files = (
  15   'menus/erp.ini'   => 'menus/user/00-erp.yaml',
  16   'menus/crm.ini'   => 'menus/user/10-crm.yaml',
  17   'menus/admin.ini' => 'menus/admin/00-admin.yaml',
  18 );
  19
  20 my %known_arguments = (
  21   ICON    => 'icon',
  22   ACCESS  => 'access',
  23   INSTANCE_CONF => 'INSTANCE_CONF',
  24   module  => 'module',
  25   submenu => 'submenu',
  26   target  => 'target',
  27   href    => 'href',
  28 );
  29
  30 sub translate_to_yaml {
  31   my ($menu_file, $new_file) = @_;
  32
  33   my %counter;
  34
  35   my $menu       = Inifile->new($menu_file);
  36   my @menu_items = map { +{ %{ $menu->{$_} }, ID => $_ } } @{ delete $menu->{ORDER} };
  37
  38   for my $item (@menu_items) {
  39     # parse id
  40     my @tokens = split /--/, delete $item->{ID};
  41     my $name   = pop @tokens;
  42     my $parent = join '_', map { lc $_ } @tokens;
  43     my $id     = join '_', grep $_, $parent, lc $name;
  44
  45     # move unknown arguments to param subhash
  46     my @keys = keys %$item;
  47     my %params;
  48     for (@keys) {
  49       next if $known_arguments{$_};
  50       $params{$_} = delete $item->{$_};
  51     }
  52
  53     $item->{params} = \%params if keys %params;
  54
  55     # sanitize keys
  56     for (keys %known_arguments) {
  57       next unless exists $item->{$_};
  58       my $val = delete $item->{$_};
  59       $item->{ $known_arguments{$_} } = $val;
  60     }
  61
  62     # sanitize submenu
  63     if ($item->{submenu}) {
  64       delete $item->{submenu};
  65     }
  66
  67     # sanitize INSTANCE_CONF
  68     if ($item->{INSTANCE_CONF}) {
  69       my $instance_conf = delete $item->{INSTANCE_CONF};
  70       if ($item->{access}) {
  71         if ($item->{access} =~ /\W/) {
  72           $item->{access} = "client/$instance_conf & ( $item->{access} )";
  73         } else {
  74           $item->{access} = "client/$instance_conf & $item->{access}";
  75         }
  76       } else {
  77         $item->{access} = "client/$instance_conf";
  78       }
  79     }
  80
  81     # make controller.pl implicit
  82     if ($item->{module} && $item->{module} eq 'controller.pl') {
  83       delete $item->{module};
  84     }
  85
  86     # add id
  87     $item->{id} = $id;
  88     $item->{id} =~ s/[^\w]+/_/g;
  89
  90     # add to name
  91     $item->{name} = $name;
  92
  93     # add parent
  94     if ($parent) {
  95       $item->{parent} = $parent;
  96       $item->{parent} =~ s/[^\w]+/_/g if $item->{parent};
  97     }
  98
  99     # add order
 100     $item->{order} = 100 * ++$counter{ $item->{parent} };
 101   }
 102
 103   if ($menu_file =~ /crm/) {
 104     $menu_items[0]{order} = 50; # crm first
 105   }
 106
 107   open my $out_file, '>:utf8', $new_file or die $!;
 108   print $out_file yaml_dump(\@menu_items);
 109 }
 110
 111 sub yaml_dump {
 112   my ($ary_ref) = @_;
 113   # YAML dumps keys lexically sorted, which isn't what we want.
 114   # we want this order:
 115   my @order = qw(
 116     parent
 117     id
 118     name
 119     icon
 120     order
 121     access
 122     href
 123     module
 124     target
 125     params
 126   );
 127
 128   # ...oh and we want action in params first
 129   #
 130   # why this? because:
 131   # 1. parent is what is used to anchor. one could argue that id should be
 132   #    first, but parent is easier for understanding structure.
 133   # 2. after parent the logical structure is
 134   #    1. id
 135   #    2. stuff related to vidual presentation (name/icon)
 136   #    3. stuff needed for logical presentaion (order/access)
 137   #    4. stuff related to the action after clicking it
 138   # 3. without parent and href (the second is pretty rare) the keys are nicely
 139   #    ascending in length, which is very easy to parse visually.
 140
 141   my $yaml = "---\n";
 142   for my $node (@$ary_ref) {
 143     my $first = 0;
 144     for my $key (@order) {
 145       next unless exists $node->{$key};
 146       $yaml .= ($first++ ? '  ' : '- ') . $key . ":";
 147       if (!ref $node->{$key}) {
 148         $yaml .= ' ' . $node->{$key} . "\n";
 149       } else {
 150         $yaml .= "\n";
 151         for ('action', grep !/^action$/, keys %{ $node->{$key} }) {
 152           next unless exists $node->{$key}{$_};
 153           $yaml .= "    $_: $node->{$key}{$_}\n";
 154         }
 155       }
 156
 157     }
 158   }
 159
 160   $yaml;
 161 }
 162
 163 while (my ($in, $out) = each(%menu_files)) {
 164   translate_to_yaml($in, $out);
 165 }
 166