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 those stupid menu inlinks
  68     if ($item->{module} eq 'menu.pl') {
  69       delete $item->{module};
  70       delete $item->{action};
  71       delete $item->{target};
  72     }
  73
  74     # sanitize INSTANCE_CONF
  75     if ($item->{INSTANCE_CONF}) {
  76       my $instance_conf = delete $item->{INSTANCE_CONF};
  77       if ($item->{access}) {
  78         if ($item->{access} =~ /\W/) {
  79           $item->{access} = "client/$instance_conf & ( $item->{access} )";
  80         } else {
  81           $item->{access} = "client/$instance_conf & $item->{access}";
  82         }
  83       } else {
  84         $item->{access} = "client/$instance_conf";
  85       }
  86     }
  87
  88     # make controller.pl implicit
  89     if ($item->{module} && $item->{module} eq 'controller.pl') {
  90       delete $item->{module};
  91     }
  92
  93     # add id
  94     $item->{id} = $id;
  95     $item->{id} =~ s/[^\w]+/_/g;
  96
  97     # add to name
  98     $item->{name} = $name;
  99
 100     # add parent
 101     if ($parent) {
 102       $item->{parent} = $parent;
 103       $item->{parent} =~ s/[^\w]+/_/g if $item->{parent};
 104     }
 105
 106     # add order
 107     $item->{order} = 100 * ++$counter{ $item->{parent} };
 108   }
 109
 110   if ($menu_file =~ /crm/) {
 111     $menu_items[0]{order} = 50; # crm first
 112   }
 113
 114   open my $out_file, '>:utf8', $new_file or die $!;
 115   print $out_file yaml_dump(\@menu_items);
 116 }
 117
 118 sub yaml_dump {
 119   my ($ary_ref) = @_;
 120   # YAML dumps keys lexically sorted, which isn't what we want.
 121   # we want this order:
 122   my @order = qw(
 123     parent
 124     id
 125     name
 126     icon
 127     order
 128     access
 129     href
 130     module
 131     target
 132     params
 133   );
 134
 135   # ...oh and we want action in params first
 136   #
 137   # why this? because:
 138   # 1. parent is what is used to anchor. one could argue that id should be
 139   #    first, but parent is easier for understanding structure.
 140   # 2. after parent the logical structure is
 141   #    1. id
 142   #    2. stuff related to vidual presentation (name/icon)
 143   #    3. stuff needed for logical presentaion (order/access)
 144   #    4. stuff related to the action after clicking it
 145   # 3. without parent and href (the second is pretty rare) the keys are nicely
 146   #    ascending in length, which is very easy to parse visually.
 147
 148   my $yaml = "---\n";
 149   for my $node (@$ary_ref) {
 150     my $first = 0;
 151     for my $key (@order) {
 152       next unless exists $node->{$key};
 153       $yaml .= ($first++ ? '  ' : '- ') . $key . ":";
 154       if (!ref $node->{$key}) {
 155         $yaml .= ' ' . $node->{$key} . "\n";
 156       } else {
 157         $yaml .= "\n";
 158         for ('action', grep !/^action$/, keys %{ $node->{$key} }) {
 159           next unless exists $node->{$key}{$_};
 160           $yaml .= "    $_: $node->{$key}{$_}\n";
 161         }
 162       }
 163
 164     }
 165   }
 166
 167   $yaml;
 168 }
 169
 170 while (my ($in, $out) = each(%menu_files)) {
 171   translate_to_yaml($in, $out);
 172 }
 173