API tools faq
paste
Advertisement
delvin-fil

xdg_menu

delvin-fil
Apr 24th, 2017
1,273
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 62.84 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl -w
  2.  
  3. #
  4. # xdg-menu for archlinux. based on suse xdg-menu written by <nadvornik@suse.cz>
  5. # Sergej Pupykin <pupykin.s@gmail.com>
  6. #
  7.  
  8. # >> Copyright (c) 2003 SuSE Linux AG, Nuernberg, Germany. All rights reserved.
  9. # >>
  10. # >> Author: nadvornik@suse.cz
  11. # >>
  12.  
  13. use strict;
  14. no warnings qw(uninitialized prototype);
  15. use Getopt::Long;
  16. use Encode;
  17. use I18N::Langinfo qw(langinfo CODESET);
  18. use POSIX qw(locale_h);
  19. use Digest::MD5 qw(md5_hex);
  20.  
  21. my $Version = "0.7.6.2";
  22.  
  23. my $DefaultAppDirs;
  24. my $DefaultDirectoryDirs;
  25. my @KDELegacyDirs;
  26.  
  27. my $format = 'WindowMaker';
  28. my $desktop_name;
  29. my $language = '';
  30. my $charset = 'iso-8859-1';
  31. my $root_cmd = 'xdg_menu_su';
  32.  
  33. my $die_on_error = 0;
  34. my $verbose = 0;
  35. my $fullmenu = 0;
  36.  
  37. my @language_keys;
  38.  
  39. my @accessed_files;
  40. my @save_ARGV = @ARGV;
  41. my $kdeconfig = get_kde_config();
  42.  
  43. my %Desktop_entries;
  44. my %Directory_entries;
  45.  
  46. sub check_file ($)
  47. {
  48.     my ($file) =@_;
  49.  
  50.     unless (-e $file)
  51.     {
  52.         push @accessed_files, "X $file";
  53.         return '';
  54.     }
  55.  
  56.     if (-d $file)
  57.     {
  58.         push @accessed_files, "D $file";
  59.         return 'D';
  60.     }
  61.     else
  62.     {
  63.         push @accessed_files, "F $file";
  64.         return 'F';
  65.     }
  66. }
  67.  
  68. sub findicon
  69. {
  70. #       my $theme = "hicolor";
  71.  
  72.         my $iconname = shift;
  73.  
  74.         my $home = $ENV{"HOME"};
  75.         my $xdg_data_dirs = $ENV{"XDG_DATA_DIRS"} || "/usr/local/share:/usr/share";
  76.  
  77.         my (@xdg_data_dirs);
  78.         @xdg_data_dirs = split(":",$xdg_data_dirs);
  79.  
  80.         my (@icon_search_path);
  81.         push @icon_search_path, "/";
  82.  
  83.         my (@categorylist);
  84.         @categorylist = ("apps", "places", "devices", "actions", "animations", "categories", "emblems", "emotes", "filesystems", "intl", "mimetypes", "status", "stock");
  85.  
  86.         my (@sizelist);
  87.         @sizelist = (16, 22, 24, 26, 32, 36, 48, 64, 72, 128, 192, 256);
  88.  
  89.         my $thisdir = $home."/.icons";
  90.         ( -d $thisdir ) && push @icon_search_path, $thisdir;
  91.         foreach my $dir (@xdg_data_dirs)
  92.         {
  93.                 my $theme = "hicolor";
  94.                 my $size;
  95.                 my $category;
  96.                 foreach $size (@sizelist)
  97.                 {
  98.                         foreach $category (@categorylist)
  99.                         {
  100.                                 $thisdir = $dir."/icons/".$theme."/".$size."x".$size."/".$category;
  101.                                 ( -d $thisdir ) && push @icon_search_path, $thisdir;
  102.                         }
  103.                 }
  104.                 $thisdir = $dir."/icons/mini";
  105.                 ( -d $thisdir ) && push @icon_search_path, $thisdir;
  106.                 $thisdir = $dir."/icons";
  107.                 ( -d $thisdir ) && push @icon_search_path, $thisdir;
  108.                 $thisdir = $dir."/icons/large";
  109.                 ( -d $thisdir ) && push @icon_search_path, $thisdir;
  110.                 $theme = "gnome";
  111.                 foreach $size (@sizelist)
  112.                 {
  113.                         foreach $category (@categorylist)
  114.                         {
  115.                                 $thisdir = $dir."/icons/".$theme."/".$size."x".$size."/".$category;
  116.                                 ( -d $thisdir ) && push @icon_search_path, $thisdir;
  117.  
  118.                         }
  119.                 }
  120.         }
  121.  
  122.         push @icon_search_path, "/usr/share/pixmaps";
  123.  
  124.         my $filename;
  125.  
  126.         #if ( -f $iconname )
  127.         #{
  128.         #        return $iconname;
  129.         #}
  130.         #else
  131.         {
  132.  
  133.                 foreach my $dir (@icon_search_path)
  134.                 {
  135.                         foreach my $ext ('','.png','.xpm','.svg')
  136.                         {
  137.                                 $filename = $dir."/".$iconname.$ext;
  138.                                 ( -f $filename ) && return $filename;
  139.                         }
  140.                 }
  141.         }
  142. }
  143.  
  144. # sub add_png_extension_if_needed ($)
  145. # {
  146. #         my ($f) = @_;
  147. #         return $f =~ /\.(png|xpm|svg)$/ ? $f : "$f.png";
  148. # }
  149.  
  150. sub scan_AppDir ($$;$)
  151. {
  152.     my ($pool, $dir, $topdir) = @_;
  153.  
  154.     check_file($dir);
  155.     $topdir = $dir unless defined $topdir;
  156.  
  157.     return if(check_file($dir) ne 'D');
  158.  
  159.     my $DIR;
  160.  
  161.     opendir($DIR, $dir) or return;
  162.  
  163.     foreach my $entry (readdir($DIR))
  164.     {
  165.         if ( -f "$dir/$entry" && $entry =~ /\.desktop$/ )
  166.         {
  167.             read_desktop_entry($pool, "$dir/$entry", $topdir);
  168.         }
  169.         elsif ( -d "$dir/$entry" && $entry ne '.' && $entry ne '..' && $entry ne '.hidden')
  170.         {
  171.             scan_AppDir ($pool, "$dir/$entry", $topdir);
  172.         }
  173.     }
  174.     closedir $DIR;
  175. }
  176.  
  177. sub scan_DirectoryDir ($$;$)
  178. {
  179.     my ($pool, $dir, $topdir) = @_;
  180.  
  181.     check_file($dir);
  182.     $topdir = $dir unless defined $topdir;
  183.  
  184.     opendir(DIR, $dir) or return;
  185.  
  186.     foreach my $entry (readdir(DIR))
  187.     {
  188.         if ( -f "$dir/$entry" && $entry =~ /\.directory$/ )
  189.         {
  190.             read_directory_entry($pool, "$dir/$entry", $topdir);
  191.         }
  192.         elsif ( -d "$dir/$entry" && $entry ne '.' && $entry ne '..' && $entry ne '.hidden')
  193.         {
  194.             scan_DirectoryDir ($pool, "$dir/$entry", $topdir);
  195.         }
  196.     }
  197.  
  198.     closedir DIR;
  199. }
  200.  
  201. sub read_directory_entry
  202. {
  203.     my ($pool, $file, $topdir) = @_;
  204.  
  205.     unless (defined $Directory_entries{$file})
  206.     {
  207.         check_file($file);
  208.  
  209.         open(FILE, "<$file") or return;
  210.  
  211.         my $in_desktop_entry = 0;
  212.         my %entry;
  213.         while (<FILE>)
  214.         {
  215.             if (/^\[/)
  216.             {
  217.                 if (/^\[Desktop Entry\]/)
  218.                 {
  219.                     $in_desktop_entry = 1;
  220.                 }
  221.                 elsif (/^\[.*\]/)
  222.                 {
  223.                     $in_desktop_entry = 0;
  224.                 }
  225.             }
  226.             elsif ($in_desktop_entry && /^([^=]*)=([^[:cntrl:]]*)/)
  227.             {
  228.                 $entry{$1} = $2;
  229.             }
  230.         }
  231.         close(FILE);
  232.  
  233.         my $id = $file;
  234.         $id =~ s/^$topdir//;
  235.         $id =~ s/^\/*//;
  236.         $id =~ s/\//-/g;
  237.         $entry{'id'} = $id;
  238.  
  239.         $Directory_entries{$file} = \%entry;
  240.     }
  241.  
  242.     my $entry = $Directory_entries{$file};
  243.  
  244.     $pool->{'Directory_entries'}{$entry->{'id'}} = $entry;
  245. }
  246.  
  247. sub check_show_in ($)
  248. {
  249.     my ($entry) = @_;
  250.  
  251.     return 1 unless defined $entry;
  252.  
  253.     my %OnlyShowIn;
  254.     my %NotShowIn;
  255.  
  256.     if (defined $entry->{'OnlyShowIn'})
  257.     {
  258.         foreach my $showin (split /;/, $entry->{'OnlyShowIn'})
  259.     {
  260.       $OnlyShowIn{$showin} = 1;
  261.     }
  262.     return 0 unless defined $OnlyShowIn{$desktop_name};
  263.   }
  264.   if (defined $entry->{'NotShowIn'})
  265.   {
  266.     foreach my $showin (split /;/, $entry->{'NotShowIn'})
  267.     {
  268.       $NotShowIn{$showin} = 1;
  269.     }
  270.     return 0 if defined $NotShowIn{$desktop_name} ;
  271.   }
  272.  
  273.   return 1;
  274. }
  275.  
  276. sub read_desktop_entry
  277. {
  278.     my ($pool, $file, $topdir) = @_;
  279.  
  280.     unless (defined $Desktop_entries{$file})
  281.     {
  282.         check_file($file);
  283.  
  284.         open(FILE, "<$file") or return;
  285.  
  286.         my $in_desktop_entry = 0;
  287.         my %entry;
  288.         while (<FILE>)
  289.         {
  290.             if (/^\[/)
  291.             {
  292.                 if (/^\[Desktop Entry\]/)
  293.         {
  294.           $in_desktop_entry = 1;
  295.         }
  296.         elsif (/^\[.*\]/)
  297.         {
  298.           $in_desktop_entry = 0;
  299.         }
  300.       }
  301.       elsif ($in_desktop_entry && /^([^=]*)=([^[:cntrl:]]*)/)
  302.       {
  303.         $entry{$1} = $2;
  304.       }
  305.     }
  306.     close(FILE);
  307.  
  308.     my $id = $file;
  309.     $id =~ s/^$topdir//;
  310.       $id =~ s/^\/*//;
  311.       $id =~ s/\//-/g;
  312.     $entry{'id'} = $id;
  313.  
  314.     $entry{'refcount'} = 0;
  315.     $Desktop_entries{$file} = \%entry;
  316.   }
  317.  
  318.   my $entry = $Desktop_entries{$file};
  319.  
  320.   return unless defined $entry->{'Name'};
  321.   return unless defined $entry->{'Exec'};
  322.   return if $entry->{'Hidden'} eq 'true';
  323.   return if $entry->{'NoDisplay'} eq 'true';
  324.  
  325.   return unless check_show_in($entry);
  326.  
  327.   return if defined $entry->{'NotShowIn'} && $entry->{'NotShowIn'} eq $desktop_name;
  328.  
  329.  
  330.   if (defined $pool)
  331.   {
  332.     foreach my $category (split /;/, $entry->{'Categories'})
  333.                 {
  334.                     $pool->{'Categories'}{$category} = [] unless defined $pool->{'Categories'}{$category};
  335.                     push @{$pool->{'Categories'}{$category}}, $entry;
  336.                 }
  337.                 $pool->{'Desktop_entries'}{$entry->{'id'}} = $entry;
  338.             }
  339.             return $entry;
  340.         }
  341.  
  342.         my $cached_pool;
  343.  
  344.         sub read_desktop_entries ($$)
  345. {
  346.     my ($directory_paths, $desktop_paths) = @_;
  347.  
  348.     if ($cached_pool->{'Directory_paths'} eq $directory_paths &&
  349.         $cached_pool->{'Desktop_paths'} eq $desktop_paths) {
  350.  
  351.         return $cached_pool;
  352.     }
  353.  
  354.  
  355.     my $pool = {'Desktop_entries' => {},
  356.                 'Categories' => {},
  357.                 'Directory_entries' => {},
  358.                 'Directory_paths' => $directory_paths,
  359.                 'Desktop_paths' => $desktop_paths
  360.     };
  361.  
  362.     foreach my $dir (split /:/, $directory_paths) {
  363.         next if $dir =~ /^\s*$/;
  364.         scan_DirectoryDir($pool, $dir);
  365.     }
  366.  
  367.     foreach my $dir (split /:/, $desktop_paths) {
  368.         next if $dir =~ /^\s*$/;
  369.         scan_AppDir($pool, $dir);
  370.     }
  371.  
  372.     $cached_pool = $pool;
  373.  
  374.     return $pool;
  375. }
  376.  
  377. sub dump_entry_list ($)
  378. {
  379.     my ($list) = @_;
  380.  
  381.     print "list: ";
  382.     foreach my $entry (@$list) {
  383.         print "$entry->{id} ";
  384.     }
  385.     print "\n";
  386.  
  387. }
  388.  
  389. sub get_directory_entry ($$)
  390. {
  391.     my ($entry, $pool) = @_;
  392.  
  393.     return $pool->{'Directory_entries'}{$entry};
  394. }
  395.  
  396. sub interpret_Include
  397. {
  398.     my ($tree, $entries, $pool) = @_;
  399.     my %exist;
  400.  
  401.     my $i = 0;
  402.  
  403.  
  404.     my @list = interpret_entry_node($tree, 'Or', $pool);
  405.  
  406.     foreach my $e (@$entries) {
  407.         if ($e->{type} eq 'desktop') {
  408.             $exist{$e->{desktop}} = 1;
  409.         }
  410.     }
  411.  
  412.  
  413. #   dump_entry_list(\@list);
  414.  
  415.     foreach my $entry (@list) {
  416.  
  417.         next if $exist{$entry};
  418.  
  419.         push @$entries, {type => 'desktop', desktop => $entry};
  420.         $entry->{'refcount'}++;
  421.  
  422.         $exist{$entry} = 1;
  423.  
  424.     }
  425. }
  426.  
  427. sub interpret_Exclude
  428. {
  429.     my ($tree, $entries, $pool) = @_;
  430.  
  431.     my $i = 0;
  432.  
  433.     my @list = interpret_entry_node($tree, 'Or', $pool);
  434.  
  435.  
  436.     foreach my $entry (@list) {
  437.  
  438.         my $i = 0;
  439.         while (defined $entries->[$i]) {
  440.             my $exist = $entries->[$i];
  441.             if ($exist->{type} eq 'desktop' &&
  442.                 $exist->{desktop} eq $entry) {
  443.                 splice @$entries, $i, 1;
  444.                 $entry->{'refcount'}--;
  445.             }
  446.             else {
  447.                 $i++;
  448.             }
  449.         }
  450.     }
  451. }
  452.  
  453.  
  454. sub interpret_entry_node ($$$)
  455. {
  456.     my ($tree, $node, $pool) = @_;
  457.  
  458.     my $i = 0;
  459.     $i++ if (ref($tree->[$i]) eq 'HASH');
  460.  
  461.     my @subtree;
  462.  
  463.     while (defined $tree->[$i]) {
  464.         if ($tree->[$i] eq 'Filename') {
  465.             $i++;
  466.             if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') {
  467.                 my $entry = $tree->[$i][2];
  468.                 if (defined $pool->{'Desktop_entries'}{$entry}) {
  469.                     push @subtree, [$pool->{'Desktop_entries'}{$entry}];
  470.                 }
  471.                 else {
  472.                     push @subtree, [];
  473.                 }
  474.             }
  475.             else {
  476.                 print STDERR "Filename\n";
  477.                 exit 1 if $die_on_error;
  478.             }
  479.             $i++;
  480.         }
  481.         elsif ($tree->[$i] eq 'Category') {
  482.             $i++;
  483.             if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') {
  484.                 my $category = $tree->[$i][2];
  485.                 if (defined $pool->{'Categories'}{$category}) {
  486.                     push @subtree, $pool->{'Categories'}{$category};
  487.                 }
  488.                 else {
  489.                     push @subtree, [];
  490.                 }
  491.             }
  492.             else {
  493.                 print STDERR "Category\n";
  494.                 exit 1 if $die_on_error;
  495.             }
  496.             $i++;
  497.         }
  498.         elsif ($tree->[$i] eq 'All') {
  499.             $i++;
  500.             if (values %{$pool->{'Desktop_entries'}} > 0) {
  501.                 push @subtree, [values %{$pool->{'Desktop_entries'}}];
  502.             }
  503.             else {
  504.                 push @subtree, [];
  505.             }
  506.             $i++;
  507.         }
  508.         elsif ($tree->[$i] eq '0') {
  509.             $i++;
  510.             $i++;
  511.         }
  512.         else {
  513.             my @res = interpret_entry_node($tree->[$i+1], $tree->[$i], $pool);
  514.             push @subtree, \@res;
  515.             $i++; $i++;
  516.         }
  517.     }
  518.  
  519.     if ($node eq 'Or')
  520.     {
  521. #       print "or - \n";
  522.  
  523.         my %used;
  524.         my @res;
  525.         foreach my $st (@subtree) {
  526. #           print "  st: ";
  527. #           dump_entry_list($st);
  528.             foreach my $entry (@$st) {
  529.                 if (! defined $used{$entry}) {
  530.                     push @res, $entry;
  531.                     $used{$entry} = 1;
  532.                 }
  533.             }
  534.         }
  535. #       print " res: ";
  536. #       dump_entry_list(\@res);
  537.         return @res;
  538.     } elsif ($node eq 'And')
  539.     {
  540.         my %used;
  541.         my @res;
  542. #       print "and - \n";
  543.         my $cnt = @subtree;
  544.         my $min = @{$subtree[0]};
  545.         my $min_idx = 0;
  546.         my $idx = 0;
  547.  
  548.         foreach my $st (@subtree) {
  549. #           print "  st: ";
  550. #           dump_entry_list($st);
  551.  
  552.             my $num = @$st;
  553.             if ($num < $min) {
  554.                 $min = $num;
  555.                 $min_idx = $idx;
  556.             }
  557.  
  558.             my %dupes;
  559.             foreach my $entry (@$st) {
  560.                 next if $dupes{$entry};
  561.                 $dupes{$entry} = 1;
  562.  
  563.                 if (! defined $used{$entry}) {
  564.                     $used{$entry} = 1;
  565.                 }
  566.                 else {
  567.                     $used{$entry} ++
  568.                 }
  569.             }
  570.  
  571.             $idx ++;
  572.         }
  573.         return () if $cnt == 0;
  574.         foreach my $entry (@{$subtree[$min_idx]}) {
  575.             push @res, $entry if $used{$entry} == $cnt;
  576.         }
  577.  
  578. #       print " res: ";
  579. #       dump_entry_list(\@res);
  580.         return @res;
  581.     } elsif ($node eq 'Not')
  582.     {
  583.         my %used;
  584.         my @res;
  585. #       print "not - \n";
  586.         my $cnt = @subtree;
  587.         foreach my $st (@subtree) {
  588. #           print "  st: ";
  589. #           dump_entry_list($st);
  590.             foreach my $entry (@$st) {
  591.                 $used{$entry} = 1;
  592.             }
  593.         }
  594.         return if $cnt == 0;
  595.         foreach my $entry (values %{$pool->{'Desktop_entries'}}) {
  596.             push @res, $entry if !defined $used{$entry};
  597.         }
  598.  
  599. #       print " res: ";
  600. #       dump_entry_list(\@res);
  601.         return @res;
  602.     } else {
  603.         print STDERR "Can't use '$node' inside <Include> or <Exclude>\n";
  604.         exit 1 if $die_on_error;
  605.         return ();
  606.     }
  607. }
  608.  
  609. sub interpret_root ($$)
  610. {
  611.     my ($tree, $topdir) = @_;
  612.     if ($tree->[0] eq 'Menu') {
  613.         return interpret_menu($tree->[1]);
  614.     }
  615.     else {
  616.         print STDERR "No toplevel Menu\n";
  617.         exit 1 if $die_on_error;
  618.         return;
  619.     }
  620. }
  621.  
  622.  
  623. sub interpret_menu ($;$$)
  624. {
  625.     my ($tree, $directory_paths, $desktop_paths) = @_;
  626.  
  627.     $directory_paths = '' unless defined $directory_paths;
  628.     $desktop_paths = '' unless defined $desktop_paths;
  629.  
  630.     my %menu = ('entries' => [],
  631.                 'OnlyUnallocated' => 0,
  632.                 'DontShowIfEmpty' => 0,
  633.                 'Deleted' => 0);
  634.  
  635.     my $i = 0;
  636.  
  637.     $i++ if (ref($tree->[$i]) eq 'HASH');
  638.  
  639.     while (defined $tree->[$i]) {
  640.         if ($tree->[$i] eq 'AppDir') {
  641.             if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') {
  642.                 $desktop_paths .= ':' . $tree->[$i + 1][2];
  643.                 splice @$tree, $i, 2;
  644.             }
  645.             else {
  646.                 print STDERR "wrong AppDir\n";
  647.                 exit 1 if $die_on_error;
  648.                 $i++;
  649.                 $i++;
  650.             }
  651.         }
  652.         elsif ($tree->[$i] eq 'DefaultAppDirs') {
  653.             $desktop_paths .= ':' . $DefaultAppDirs;
  654.             splice @$tree, $i, 2;
  655.         }
  656.         elsif ($tree->[$i] eq 'DirectoryDir') {
  657.             if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') {
  658.                 $directory_paths .= ':' . $tree->[$i + 1][2];
  659.                 splice @$tree, $i, 2;
  660.             }
  661.             else {
  662.                 print STDERR "wrong DirectoryDir\n";
  663.                 exit 1 if $die_on_error;
  664.                 $i++;
  665.                 $i++;
  666.             }
  667.         }
  668.         elsif ($tree->[$i] eq 'DefaultDirectoryDirs') {
  669.             $directory_paths .= ':' . $DefaultDirectoryDirs;
  670.             splice @$tree, $i, 2;
  671.         }
  672.         else {
  673.             $i++;
  674.             $i++;
  675.         }
  676.     }
  677.  
  678.  
  679.     $menu{directory_paths} = $directory_paths;
  680.     $menu{desktop_paths} = $desktop_paths;
  681.  
  682.     my $pool = read_desktop_entries($directory_paths, $desktop_paths);
  683.  
  684.  
  685.     $i = 0;
  686.  
  687.     $i++ if (ref($tree->[$i]) eq 'HASH');
  688.  
  689.     while (defined $tree->[$i]) {
  690.         if ($tree->[$i] eq 'Menu') {
  691.             $i++;
  692.             my $submenu = interpret_menu($tree->[$i], $directory_paths, $desktop_paths);
  693.             push @{$menu{'entries'}}, {type => 'menu', menu => $submenu};
  694.             $i++;
  695.         }
  696.         elsif ($tree->[$i] eq 'Name') {
  697.             $i++;
  698.             if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') {
  699.                 $menu{'Name'} = $tree->[$i][2];
  700.             }
  701.             else {
  702.                 print STDERR "wrong Name\n";
  703.                 exit 1 if $die_on_error;
  704.             }
  705.             $i++;
  706.         }
  707.         elsif ($tree->[$i] eq 'Directory') {
  708.             $i++;
  709.             if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') {
  710.                 $menu{'Directory'} = get_directory_entry($tree->[$i][2], $pool);
  711. #               print "Directory " . $tree->[$i][2] . "\n";
  712.             }
  713.             else {
  714.                 print STDERR "wrong Directory\n";
  715.                 exit 1 if $die_on_error;
  716.             }
  717.             $i++;
  718.         }
  719.         elsif ($tree->[$i] eq 'OnlyUnallocated') {
  720.             $menu{'OnlyUnallocated'} = 1;
  721.             $i++;
  722.             $i++;
  723.         }
  724.         elsif ($tree->[$i] eq 'DontShowIfEmpty') {
  725.             $menu{'DontShowIfEmpty'} = 1;
  726.             $i++;
  727.             $i++;
  728.         }
  729.         elsif ($tree->[$i] eq 'Deleted') {
  730.             $menu{'Deleted'} = 1;
  731.             $i++;
  732.             $i++;
  733.         }
  734.         elsif ($tree->[$i] eq 'NotDeleted') {
  735.             $menu{'Deleted'} = 0;
  736.             $i++;
  737.             $i++;
  738.         }
  739.         elsif ($tree->[$i] eq 'Include') {
  740.             $i++;
  741.             interpret_Include($tree->[$i], $menu{'entries'}, $pool);
  742.             $i++;
  743.         }
  744.         elsif ($tree->[$i] eq 'Exclude') {
  745.             $i++;
  746.             interpret_Exclude($tree->[$i], $menu{'entries'}, $pool);
  747.             $i++;
  748.         }
  749.         elsif ($tree->[$i] eq '0') {
  750.             $i++;
  751.             if ($tree->[$i] !~ /^\s*$/) {
  752.                 print STDERR "skip '$tree->[$i]'\n" ;
  753.                 exit 1 if $die_on_error;
  754.             }
  755.             $i++;
  756.         }
  757.         else {
  758.             print STDERR "Unknown '$tree->[$i]':\n";
  759.             $i++;
  760.             print STDERR "        '@{$tree->[$i]}'\n";
  761.             $i++;
  762.             exit 1 if $die_on_error;
  763.         }
  764.     }
  765.  
  766.     return \%menu;
  767. }
  768.  
  769.  
  770. sub read_menu ($;$)
  771. {
  772.     my ($file, $basedir) = @_;
  773.  
  774.  
  775.     if ($file !~ /^\// && defined $basedir) {
  776.         $file = "$basedir/$file";
  777.     }
  778.  
  779.     unless (defined $basedir) {
  780.         $basedir = $file;
  781.         $basedir =~ s/\/[^\/]*$//;
  782.     }
  783.  
  784.     unless (check_file($file)) {
  785.         print STDERR "WARNING: '$file' does not exist\n";
  786.         return ['Menu', [{}]];
  787.     }
  788.  
  789.     print STDERR "reading '$file'\n" if $verbose;
  790.  
  791.     my $parser = new XML::Parser(Style => 'Tree');
  792.     my $tree = $parser->parsefile($file);
  793.  
  794.     my $DefaultMergeDir = $file;
  795.     $DefaultMergeDir =~ s/^.*\///;
  796.     $DefaultMergeDir =~ s/\.menu$/-merged/;
  797.  
  798.     read_includes($tree, $basedir, $DefaultMergeDir);
  799.  
  800.     return $tree
  801. }
  802.  
  803. sub read_menu_dir ($;$)
  804. {
  805.     my ($dir, $basedir) = @_;
  806.  
  807.     my @out;
  808.  
  809.     if ($dir !~ /^\// && defined $basedir) {
  810.         $dir = "$basedir/$dir";
  811.     }
  812.  
  813.  
  814.     if(check_file($dir) ne 'D')
  815.     {
  816.     return [];
  817.     }
  818.  
  819.     opendir(DIR, $dir);
  820.  
  821.     foreach my $entry (readdir(DIR)) {
  822.  
  823.         if ( -f "$dir/$entry" && $entry =~ /\.menu$/ ) {
  824.             my $menu = read_menu("$dir/$entry");
  825.             $menu = remove_toplevel_Menu($menu);
  826.             push @out, @$menu;
  827.         }
  828.     }
  829.     closedir DIR;
  830.  
  831.     return \@out;
  832. }
  833.  
  834. sub quote_xml ($)
  835. {
  836.     my ($txt) = @_;
  837.  
  838.     $txt =~ s/&/&amp;/g;
  839.     $txt =~ s/</&lt;/g;
  840.     $txt =~ s/>/&gt;/g;
  841.     return $txt;
  842. }
  843.  
  844. sub read_legacy_dir ($;$)
  845. {
  846.     my ($dir,$basedir) = @_;
  847.     my $out;
  848.  
  849.     $dir =~ s/\/*$//;
  850.  
  851.     $basedir = $dir unless defined $basedir;
  852.  
  853.     return "" if check_file($dir) ne 'D';
  854.  
  855.     $out = "<Menu>\n";
  856.  
  857.     if ($dir eq $basedir) {
  858.         my $xmldir = quote_xml($dir);
  859.  
  860.         $out .= "<AppDir>$xmldir</AppDir>\n";
  861.         $out .= "<DirectoryDir>$xmldir</DirectoryDir>\n";
  862.     }
  863.     else {
  864.         my $name = $dir;
  865.         $name =~ s/\/*$//;
  866.         $name =~ s/^.*\///;
  867.  
  868.         $name = quote_xml($name);
  869.  
  870.         $out .= "<Name>$name</Name>\n";
  871.     }
  872.  
  873.  
  874.     if (-f "$dir/.directory") {
  875.  
  876.         my $dir_id = "$dir/.directory";
  877.         $dir_id =~ s/^$basedir//;
  878.         $dir_id =~ s/^\///;
  879.         $dir_id = quote_xml($dir_id);
  880.  
  881.         $out .= "<Directory>$dir_id</Directory>\n";
  882.     }
  883.  
  884.     opendir(DIR, $dir);
  885.  
  886.     foreach my $entry (readdir(DIR)) {
  887.  
  888.         if ( -f "$dir/$entry" && $entry =~ /\.desktop$/ ) {
  889.             my $id = "$dir/$entry";
  890.             $id =~ s/^$basedir//;
  891.             $id =~ s/^\///;
  892.             $id =~ s/\//-/g;
  893.             $id = quote_xml($id);
  894.  
  895.             my $desktop = read_desktop_entry(undef, "$dir/$entry", $basedir);
  896.             $out .= "<Include><Filename>$id</Filename></Include>\n" unless defined $desktop->{'Categories'}
  897.         }
  898.         elsif ( -d "$dir/$entry" && $entry ne '.' && $entry ne '..' && $entry ne '.hidden') {
  899.             $out .= read_legacy_dir("$dir/$entry", $basedir);
  900.         }
  901.     }
  902.     closedir DIR;
  903.     $out .= "</Menu>\n";
  904.     return $out;
  905. }
  906.  
  907. sub remove_toplevel_Menu ($)
  908. {
  909.     my ($tree) = @_;
  910.     if ($tree->[0] eq 'Menu') {
  911.         shift @{$tree->[1]} if (ref($tree->[1][0]) eq 'HASH');
  912.         return $tree->[1];
  913.     }
  914.     else {
  915.         print STDERR "No toplevel Menu\n";
  916.         exit 1 if $die_on_error;
  917.         return;
  918.     }
  919. }
  920.  
  921. sub read_includes ($$$)
  922. {
  923.     my ($tree, $basedir, $DefaultMergeDir) = @_;
  924.  
  925.     my $i = 0;
  926.  
  927.     $i++ if (ref($tree->[$i]) eq 'HASH');
  928.  
  929.     while (defined $tree->[$i]) {
  930.         if ($tree->[$i] eq 'MergeFile') {
  931.             if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') {
  932.                 my $add_tree = read_menu($tree->[$i + 1][2], $basedir);
  933.                 $add_tree = remove_toplevel_Menu($add_tree);
  934.  
  935.                 splice @$tree, $i, 2, @$add_tree;
  936.  
  937.             }
  938.             else {
  939.                 print STDERR "wrong MergeFile\n";
  940.                 exit 1 if $die_on_error;
  941.                 $i++;
  942.                 $i++;
  943.             }
  944.  
  945.         }
  946.         elsif ($tree->[$i] eq 'MergeDir') {
  947.             if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') {
  948.  
  949.                 my $add_tree = read_menu_dir($tree->[$i + 1][2], $basedir);
  950.  
  951.                 splice @$tree, $i, 2, @$add_tree;
  952.  
  953.             }
  954.             else {
  955.                 print STDERR "wrong MergeFile\n";
  956.                 exit 1 if $die_on_error;
  957.                 $i++;
  958.                 $i++;
  959.             }
  960.         }
  961.         elsif ($tree->[$i] eq 'DefaultMergeDirs') {
  962.             my $add_tree = read_menu_dir($DefaultMergeDir, $basedir);
  963.             splice @$tree, $i, 2, @$add_tree;
  964.         }
  965.         elsif ($tree->[$i] eq 'LegacyDir') {
  966.             if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') {
  967.         if( -d $tree->[$i + 1][2])
  968.         {
  969.                     my $xml = read_legacy_dir($tree->[$i + 1][2]);
  970.                     print STDERR "reading legacy directory '" . $tree->[$i + 1][2] . "'\n" if $verbose;
  971.                     my $parser = new XML::Parser(Style => 'Tree');
  972.                     my $add_tree = $parser->parse($xml);
  973.                     $add_tree = remove_toplevel_Menu($add_tree);
  974.                     splice @$tree, $i, 2, @$add_tree;
  975.         }
  976.         else
  977.         {
  978.                     print STDERR "legacy directory '" . $tree->[$i + 1][2] . "' not found\n" if $verbose;
  979.                     splice @$tree, $i, 2, ();
  980.         }
  981.             }
  982.             else {
  983.                 print STDERR "wrong LegacyDir\n";
  984.                 exit 1 if $die_on_error;
  985.                 $i++;
  986.                 $i++;
  987.             }
  988.         }
  989.         elsif ($tree->[$i] eq 'KDELegacyDirs') {
  990.             my @out;
  991.             foreach my $dir (@KDELegacyDirs) {
  992.                 my $xml = read_legacy_dir($dir);
  993.                 print STDERR "reading legacy directory '$dir'\n" if $verbose;
  994.  
  995.                 my $parser = new XML::Parser(Style => 'Tree');
  996.                 my $add_tree = $parser->parse($xml);
  997.                 $add_tree = remove_toplevel_Menu($add_tree);
  998.                 push @out, @$add_tree
  999.             }
  1000.             splice @$tree, $i, 2, @out;
  1001.         }
  1002.         elsif ($tree->[$i] eq 'Menu') {
  1003.             $i++;
  1004.             read_includes($tree->[$i], $basedir, $DefaultMergeDir);
  1005.             $i++;
  1006.         }
  1007.         else {
  1008.             $i++;
  1009.             $i++;
  1010.         }
  1011.     }
  1012. }
  1013.  
  1014. sub get_menu_name ($)
  1015. {
  1016.     my ($tree) = @_;
  1017.     my $name;
  1018.  
  1019.     my $i = 0;
  1020.  
  1021.     $i++ if (ref($tree->[$i]) eq 'HASH');
  1022.  
  1023.     while (defined $tree->[$i]) {
  1024.         if ($tree->[$i] eq 'Name') {
  1025.             $i++;
  1026.             if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') {
  1027.                 $name = $tree->[$i][2];
  1028.                 last;
  1029.             }
  1030.             else {
  1031.                 print STDERR "wrong Name\n";
  1032.             }
  1033.             $i++;
  1034.         }
  1035.         else {
  1036.             $i++;
  1037.             $i++;
  1038.         }
  1039.     }
  1040.  
  1041.     unless (defined $name) {
  1042.         print STDERR "Menu has no name element\n";
  1043.     }
  1044.     return $name;
  1045. }
  1046.  
  1047.  
  1048. sub append_menu ($$)
  1049. {
  1050.     my ($target, $source) = @_;
  1051.  
  1052.     my $i = 0;
  1053.  
  1054.     $i++ if (ref($source->[$i]) eq 'HASH');
  1055.  
  1056.     while (defined $source->[$i]) {
  1057.         if ($source->[$i] ne 'Name') {
  1058.             push @$target, $source->[$i];
  1059.             push @$target, $source->[$i + 1];
  1060.         }
  1061.  
  1062.         $i++;
  1063.         $i++;
  1064.     }
  1065. }
  1066.  
  1067.  
  1068. sub merge_menus ($)
  1069. {
  1070.     my ($tree) = @_;
  1071.  
  1072.     my %used; #menu name already used
  1073.  
  1074.     my $i = 0;
  1075.  
  1076.     $i++ if (ref($tree->[$i]) eq 'HASH');
  1077.  
  1078.     while (defined $tree->[$i]) {
  1079.         if ($tree->[$i] eq 'Menu') {
  1080.             my $name = get_menu_name($tree->[$i + 1]);
  1081.             if (defined $used{$name}) { #second menu with the same name
  1082.                 my $target = $used{$name};
  1083.  
  1084.                 append_menu($tree->[$target], $tree->[$i + 1]);
  1085.  
  1086.                 splice @$tree, $i, 2;
  1087.             }
  1088.             else { # first appearance
  1089.                 $used{$name} = $i + 1;
  1090.                 $i++;
  1091.                 $i++;
  1092.             }
  1093.         }
  1094.         else {
  1095.             $i++;
  1096.             $i++;
  1097.         }
  1098.     }
  1099.  
  1100.  
  1101.     $i = 0;
  1102.     $i++ if (ref($tree->[$i]) eq 'HASH');
  1103.  
  1104.     while (defined $tree->[$i]) {
  1105.         if ($tree->[$i] eq 'Menu') {
  1106.             merge_menus($tree->[$i + 1]);
  1107.         }
  1108.         $i++;
  1109.         $i++;
  1110.     }
  1111. }
  1112.  
  1113. sub read_Move ($$)
  1114. {
  1115.     my ($tree, $hash) = @_;
  1116.  
  1117.     my $i = 0;
  1118.  
  1119.     my $old = '';
  1120.  
  1121.  
  1122.     $i++ if (ref($tree->[$i]) eq 'HASH');
  1123.  
  1124.     while (defined $tree->[$i]) {
  1125.         if ($tree->[$i] eq 'Old') {
  1126.             $i++;
  1127.             if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') {
  1128.                 $old = $tree->[$i][2];
  1129.             }
  1130.             else {
  1131.                 print STDERR "wrong Old\n";
  1132.                 exit 1 if $die_on_error;
  1133.             }
  1134.             $i++;
  1135.         }
  1136.         if ($tree->[$i] eq 'New')
  1137.         {
  1138.             $i++;
  1139.             if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') {
  1140.                 $hash->{$old} = $tree->[$i][2];
  1141.             }
  1142.             else {
  1143.                 print STDERR "wrong New\n";
  1144.                 exit 1 if $die_on_error;
  1145.             }
  1146.             $i++;
  1147.         }
  1148.         else
  1149.         {
  1150.             $i++;
  1151.             $i++;
  1152.         }
  1153.     }
  1154. }
  1155.  
  1156. sub find_menu_in_tree ($$)
  1157. {
  1158.     my ($path, $tree) = @_;
  1159.  
  1160.     my $root = $path;
  1161.     $root =~ s/\/.*$//;
  1162.  
  1163.     my $subpath = $path;
  1164.     $subpath =~ s/^[^\/]*\/*//;
  1165.  
  1166.     my $i = 0;
  1167.  
  1168.     $i++ if (ref($tree->[$i]) eq 'HASH');
  1169.  
  1170.     while (defined $tree->[$i])
  1171.     {
  1172.         if ($tree->[$i] eq 'Menu')
  1173.         {
  1174.             if ($root eq get_menu_name($tree->[$i + 1]))
  1175.             {
  1176.  
  1177.                 if ($subpath eq '')
  1178.                 {
  1179.                     return { 'parent' => $tree, 'index' => $i, 'menu' => $tree->[$i + 1]};
  1180.                 }
  1181.                 return find_menu_in_tree($subpath, $tree->[$i + 1]);
  1182.             }
  1183.         }
  1184.  
  1185.         $i++;
  1186.         $i++;
  1187.     }
  1188.  
  1189.     return undef;
  1190. }
  1191.  
  1192. sub copy_menu ($$)
  1193. {
  1194.     my ($path, $tree) = @_;
  1195.  
  1196.     my $tail;
  1197.     my $child;
  1198.  
  1199.     foreach my $elem (reverse split(/\//, $path))
  1200.     {
  1201.         next if $elem eq '';
  1202.  
  1203.         my $menu = [{}, 'Name', [{}, 0, $elem]];
  1204.         push @$menu, ('Menu', $child) if defined $child;
  1205.  
  1206.         $tail = $menu unless defined $tail;
  1207.         $child = $menu;
  1208.     }
  1209.  
  1210.     append_menu($tail, $tree);
  1211.  
  1212.     return $child;
  1213. }
  1214.  
  1215. sub move_menus ($)
  1216. {
  1217.     my ($tree) = @_;
  1218.  
  1219. #   print "@$tree\n";
  1220.     my %move;
  1221.  
  1222.     my $i = 0;
  1223.  
  1224.     $i++ if (ref($tree->[$i]) eq 'HASH');
  1225.  
  1226.     while (defined $tree->[$i])
  1227.     {
  1228.         if ($tree->[$i] eq 'Move')
  1229.         {
  1230.  
  1231.             read_Move($tree->[$i + 1], \%move);
  1232.             splice @$tree, $i, 2;
  1233.         }
  1234.         else
  1235.         {
  1236.             $i++;
  1237.             $i++;
  1238.         }
  1239.     }
  1240.  
  1241.     foreach my $source (keys %move)
  1242.     {
  1243.         my $sourceinfo = find_menu_in_tree($source, $tree);
  1244.  
  1245.         if (defined $sourceinfo) {
  1246.             my $target = copy_menu($move{$source}, $sourceinfo->{'menu'});
  1247.             splice @{$sourceinfo->{'parent'}}, $sourceinfo->{'index'}, 2;
  1248.             push @$tree, ('Menu', $target);
  1249.             merge_menus($tree);
  1250.         }
  1251.     }
  1252.  
  1253.     $i = 0;
  1254.     $i++ if (ref($tree->[$i]) eq 'HASH');
  1255.  
  1256.     while (defined $tree->[$i])
  1257.     {
  1258.         if ($tree->[$i] eq 'Menu')
  1259.         {
  1260.             move_menus($tree->[$i + 1]);
  1261.         }
  1262.         $i++;
  1263.         $i++;
  1264.     }
  1265. }
  1266.  
  1267. sub remove_allocated ($)
  1268. {
  1269.     my ($menu) = @_;
  1270.  
  1271.     my $i = 0;
  1272.     while ($i < @{$menu->{'entries'}})
  1273.     {
  1274.         my $entry = $menu->{'entries'}[$i];
  1275.  
  1276.         if ($entry->{type} eq 'menu')
  1277.         {
  1278.             remove_allocated($entry->{menu});
  1279.             $i++;
  1280.         }
  1281.         elsif ($entry->{type} eq 'desktop' &&
  1282.                $menu->{'OnlyUnallocated'} &&
  1283.                $entry->{desktop}{'refcount'} > 1)
  1284.         {
  1285.  
  1286.             $entry->{desktop}{'refcount'}--;
  1287.             splice @{$menu->{'entries'}}, $i, 1;
  1288.         }
  1289.         else
  1290.         {
  1291.             $i++;
  1292.         }
  1293.     }
  1294.     return 0;
  1295. }
  1296.  
  1297.  
  1298. sub remove_empty_menus ($)
  1299. {
  1300.     my ($menu) = @_;
  1301.  
  1302.  
  1303.     my $i = 0;
  1304.     while ($i < @{$menu->{'entries'}})
  1305.     {
  1306.         my $entry = $menu->{'entries'}[$i];
  1307.  
  1308.         if ($entry->{type} eq 'menu' && remove_empty_menus($entry->{menu}))
  1309.         {
  1310.             splice @{$menu->{'entries'}}, $i, 1;
  1311.         }
  1312.         else
  1313.         {
  1314.             $i++;
  1315.         }
  1316.     }
  1317.  
  1318.     return 1 if @{$menu->{'entries'}} == 0; # && $menu->{'DontShowIfEmpty'}; #menu is empty
  1319.  
  1320.     return 0;
  1321. }
  1322.  
  1323.  
  1324. sub prepare_exec ($$)
  1325. {
  1326.     my ($exec, $desktop) = @_;
  1327.  
  1328.     $exec =~ s/%f//g;
  1329.     $exec =~ s/%F//g;
  1330.     $exec =~ s/%u//g;
  1331.     $exec =~ s/%U//g;
  1332.     $exec =~ s/%d//g;
  1333.     $exec =~ s/%D//g;
  1334.     $exec =~ s/%n//g;
  1335.     $exec =~ s/%N//g;
  1336.     $exec =~ s/%i//g;
  1337.     $exec =~ s/%k//g;
  1338.     $exec =~ s/%v//g;
  1339.     $exec =~ s/%m//g;
  1340.  
  1341.     my $caption = $desktop->{Name};
  1342.  
  1343.     $exec =~ s/%c/$caption/g;
  1344.  
  1345.     $exec =~ s/%%/%/g;
  1346.  
  1347.     $exec = "xterm -e $exec" if $desktop->{Terminal} eq '1' || $desktop->{Terminal} eq 'true';
  1348.  
  1349.     $exec = "$root_cmd $exec" if $desktop->{'X-KDE-SubstituteUID'} eq '1' || $desktop->{'X-KDE-SubstituteUID'} eq 'true';
  1350.     return $exec;
  1351. }
  1352.  
  1353. sub get_loc_entry ($$)
  1354. {
  1355.     my ($desktop, $entry) = @_;
  1356.  
  1357.     foreach my $key (@language_keys)
  1358.     {
  1359.         my $loc_entry = $entry . "[$key]";
  1360.         return $desktop->{$loc_entry} if defined $desktop->{$loc_entry} && $desktop->{$loc_entry} !~ /^\s*$/;
  1361.     }
  1362.  
  1363.     return $desktop->{$entry};
  1364. }
  1365.  
  1366. sub preprocess_menu ($)
  1367. {
  1368. # localize, sort, prepare_exec
  1369.     my ($menu) = @_;
  1370.  
  1371.     return 0 if $menu->{'Deleted'};
  1372.     return 0 unless check_show_in($menu->{'Directory'});
  1373.     return 0 if defined $menu->{'Directory'} && $menu->{'Directory'}->{'NoDisplay'} eq 'true';
  1374.  
  1375.     my $menu_name = $menu->{'Name'};
  1376.  
  1377.     if (defined $menu->{'Directory'})
  1378.     {
  1379.         my $directory = $menu->{'Directory'};
  1380.  
  1381.         my $directory_name = get_loc_entry($directory, 'Name');
  1382.  
  1383.         if (defined $directory_name)
  1384.         {
  1385.             Encode::from_to($directory_name, "utf8", $charset)
  1386.                 if !defined $directory->{"Encoding"} || $directory->{"Encoding"} eq 'UTF-8';
  1387.  
  1388.             $menu_name = $directory_name;
  1389.         }
  1390.     }
  1391.  
  1392.     $menu->{'PrepName'} = $menu_name;
  1393.     $menu->{'PrepIcon'} = $menu->{"Directory"}->{"Icon"};
  1394.  
  1395.     my $i = 0;
  1396.     while (defined $menu->{'entries'}[$i])
  1397.     {
  1398.         my $entry = $menu->{'entries'}[$i];
  1399.         if ($entry->{'type'} eq 'desktop')
  1400.         {
  1401.             my $desktop = $entry->{desktop};
  1402.  
  1403.             my $name = $desktop->{'id'};
  1404.  
  1405.             my $desktop_name = get_loc_entry($desktop, 'Name');
  1406.  
  1407.             if (defined $desktop_name)
  1408.             {
  1409.                 Encode::from_to($desktop_name, "utf8", $charset)
  1410.                     if !defined $desktop->{"Encoding"} || $desktop->{"Encoding"} eq 'UTF-8';
  1411.  
  1412.                 $name = $desktop_name;
  1413.             }
  1414.  
  1415.             $desktop->{'PrepName'} = $name;
  1416.             $entry->{'Name'} = $name;
  1417.             $entry->{'PrepName'} = $name;
  1418.  
  1419.             $desktop->{'PrepExec'} = prepare_exec($desktop->{Exec}, $desktop);
  1420.             $i++;
  1421.         }
  1422.         elsif ($entry->{type} eq 'menu')
  1423.         {
  1424.             if (preprocess_menu ($entry->{'menu'}))
  1425.             {
  1426.                 $entry->{'Name'} = $entry->{'menu'}{'Name'};
  1427.                 $entry->{'PrepName'} = $entry->{'menu'}{'PrepName'};
  1428.                 $i++;
  1429.             }
  1430.             else
  1431.             {
  1432.                 splice @{$menu->{'entries'}}, $i, 1;
  1433.             }
  1434.         }
  1435.         else
  1436.         {
  1437.             print STDERR "wrong menu entry type: $entry->{type}";
  1438.             exit 1 if $die_on_error;
  1439.             splice @{$menu->{'entries'}}, $i, 1;
  1440.         }
  1441.     }
  1442.  
  1443.     $menu->{'entries'} = [ sort {$b->{'type'} cmp $a->{'type'} || $a->{'PrepName'} cmp $b->{'PrepName'}} @{$menu->{'entries'}} ];
  1444.  
  1445.     $i = 0;
  1446.     my $prev_entry;
  1447.     while (defined $menu->{'entries'}[$i])
  1448.     {
  1449.         my $entry = $menu->{'entries'}[$i];
  1450.         if (defined $prev_entry &&
  1451.             $entry->{'type'} eq 'desktop' &&
  1452.             $prev_entry->{'type'} eq 'desktop' &&
  1453.             $prev_entry->{'PrepName'} eq $entry->{'PrepName'} &&
  1454.             $prev_entry->{'desktop'}->{'PrepExec'} eq $entry->{'desktop'}->{'PrepExec'})
  1455.         {
  1456.             splice @{$menu->{'entries'}}, $i, 1;
  1457.         }
  1458.         else
  1459.         {
  1460.             $prev_entry = $entry;
  1461.             $i++;
  1462.         }
  1463.     }
  1464.  
  1465.     return 1;
  1466. }
  1467.  
  1468.  
  1469. sub output_wmaker_menu ($;$)
  1470. {
  1471.     my ($menu, $indent) = @_;
  1472.  
  1473.     my $output = '';
  1474.  
  1475.     $indent = 0 unless defined $indent;
  1476.  
  1477.     my $menu_name = $menu->{'PrepName'};
  1478.  
  1479.     $output .= ' ' x $indent;
  1480.     $output .= "\"$menu_name\" MENU\n";
  1481.  
  1482.     foreach my $entry (@{$menu->{'entries'}})
  1483.     {
  1484.         if ($entry->{type} eq 'desktop')
  1485.         {
  1486.             my $desktop = $entry->{desktop};
  1487.  
  1488.             my $name = $desktop->{'PrepName'};
  1489.             my $exec = $desktop->{'PrepExec'};
  1490.  
  1491.             $output .= ' ' x $indent;
  1492.             $output .= " \"$name\" EXEC $exec\n";
  1493.         }
  1494.         elsif ($entry->{type} eq 'menu')
  1495.         {
  1496.             $output .= output_wmaker_menu ($entry->{'menu'}, $indent + 1);
  1497.         }
  1498.         else
  1499.         {
  1500.             print STDERR "wrong menu entry type: $entry->{type}";
  1501.         }
  1502.  
  1503.     }
  1504.     $output .= ' ' x $indent;
  1505.     $output .= "\"$menu_name\" END\n";
  1506.  
  1507.     return $output;
  1508. }
  1509.  
  1510. sub output_fvwm2_menu ($;$$)
  1511. {
  1512.     my ($menu, $toplevel, $path) = @_;
  1513.  
  1514.     my $output = '';
  1515.  
  1516.     $path = '' unless defined $path;
  1517.  
  1518.     $toplevel = 1 unless defined $toplevel;
  1519.  
  1520.     my $menu_name = $menu->{'PrepName'};
  1521.     my $menu_id = "$path-" . $menu->{'Name'};
  1522.     $menu_id =~ s/\s/_/g;
  1523.  
  1524.     $menu_id = 'xdg_menu' if $toplevel;
  1525.  
  1526.     foreach my $entry (@{$menu->{'entries'}})
  1527.     {
  1528.         if ($entry->{type} eq 'menu')
  1529.         {
  1530.             $output .= output_fvwm2_menu($entry->{'menu'}, 0, $menu_id);
  1531.         }
  1532.     }
  1533.  
  1534.     $output .= "DestroyMenu \"$menu_id\"\n";
  1535.     $output .= "AddToMenu \"$menu_id\" \"$menu_name\" Title\n";
  1536.  
  1537.     foreach my $entry (@{$menu->{'entries'}})
  1538.     {
  1539.         if ($entry->{type} eq 'desktop')
  1540.         {
  1541.             my $desktop = $entry->{desktop};
  1542.  
  1543.             my $name = $desktop->{'PrepName'};
  1544.             my $exec = $desktop->{'PrepExec'};
  1545.  
  1546.             $output .= "+        \"$name\" Exec $exec\n";
  1547.         }
  1548.         elsif ($entry->{type} eq 'menu')
  1549.         {
  1550.             my $name = $entry->{'menu'}{'PrepName'};
  1551.             my $id = "$menu_id-" . $entry->{'menu'}{'Name'};
  1552.             $id =~ s/\s/_/g;
  1553.  
  1554.             $output .= "+        \"$name\" Popup \"$id\"\n";
  1555.         }
  1556.         else
  1557.         {
  1558.             print STDERR "wrong menu entry type: $entry->{type}";
  1559.         }
  1560.  
  1561.     }
  1562.     $output .= "\n";
  1563.  
  1564.     return $output;
  1565. }
  1566.  
  1567. sub output_blackbox_menu ($;$)
  1568. {
  1569.     my ($menu, $indent) = @_;
  1570.  
  1571.     my $output = '';
  1572.  
  1573.     $output .= "[begin] (Menu)\n";
  1574.     $output .= "[exec] (xterm) {xterm}\n[separator]\n";
  1575.     $output .= output_blackbox_inner_menu ($menu, $indent);
  1576.     $output .= "[separator]\n";
  1577.     $output .= '[config] (Configuration)
  1578.                [workspaces] (Workspace)
  1579.                [submenu] (System Styles) {Choose a style...}
  1580.                        [stylesdir] (/usr/share/blackbox/styles)
  1581.             [stylesdir] (/usr/share/fluxbox/styles)
  1582.             [stylesdir] (/usr/share/openbox/styles)
  1583.                [end]
  1584.                [submenu] (User Styles) {Choose a style...}
  1585.                        [stylesdir] (~/.blackbox/styles)
  1586.             [stylesdir] (~/.fluxbox/styles)
  1587.             [stylesdir] (~/.openbox/styles)
  1588.                [end]
  1589.        [separator]
  1590.        [exec] (Run Command) {bbrun -a -w}
  1591.        [exec] (Lock Screen) {xlock}
  1592.        [restart] (Restart) {}
  1593.        [exit] (Logout)
  1594. [end]
  1595.    ';
  1596.   $output .= "[end]\n";
  1597.   return $output;
  1598. }
  1599.  
  1600.  
  1601. sub output_blackbox_inner_menu ($;$)
  1602. {
  1603.     my ($menu, $indent) = @_;
  1604.  
  1605.     my $output = '';
  1606.  
  1607.     $indent = 0 unless defined $indent;
  1608.  
  1609.     my $menu_name = $menu->{'PrepName'};
  1610.  
  1611.     $output .= ' ' x $indent;
  1612.     $output .= "[submenu] ($menu_name)\n";
  1613.  
  1614.     foreach my $entry (@{$menu->{'entries'}})
  1615.     {
  1616.         if ($entry->{type} eq 'desktop')
  1617.         {
  1618.             my $desktop = $entry->{desktop};
  1619.  
  1620.             my $name = $desktop->{'PrepName'};
  1621.             my $exec = $desktop->{'PrepExec'};
  1622.  
  1623.             $output .= ' ' x $indent;
  1624.             $output .= "    [exec] ($name) {$exec}\n";
  1625.         }
  1626.         elsif ($entry->{type} eq 'menu')
  1627.         {
  1628.             $output .= output_blackbox_inner_menu ($entry->{'menu'}, $indent + 1);
  1629.         }
  1630.         else
  1631.         {
  1632.             print STDERR "wrong menu entry type: $entry->{type}";
  1633.         }
  1634.  
  1635.     }
  1636.     $output .= ' ' x $indent;
  1637.     $output .= "[end] # ($menu_name)\n";
  1638.  
  1639.     return $output;
  1640. }
  1641.  
  1642. sub output_icewm_menu ($;$)
  1643. {
  1644.     my ($menu, $indent) = @_;
  1645.  
  1646.     my $output = '';
  1647.  
  1648.     $indent = 0 unless defined $indent;
  1649.  
  1650.     my $menu_name = $menu->{'PrepName'};
  1651.     #my $menu_icon = $menu->{'PrepIcon'} || "folder" ;
  1652.     my $menu_icon = findicon($menu->{'PrepIcon'}) || "folder";
  1653.  
  1654.     if($indent)
  1655.     {
  1656.     $output .= ' ' x $indent;
  1657.     $output .= "menu \"$menu_name\" $menu_icon {\n";
  1658.     }
  1659.  
  1660.     foreach my $entry (@{$menu->{'entries'}})
  1661.     {
  1662.         if ($entry->{type} eq 'desktop')
  1663.         {
  1664.             my $desktop = $entry->{desktop};
  1665.  
  1666.             my $name = $desktop->{'PrepName'};
  1667.             my $exec = $desktop->{'PrepExec'};
  1668.             my $icon = findicon($desktop->{'Icon'}) || "-";
  1669.  
  1670.             $output .= ' ' x $indent;
  1671.             $output .= " prog \"$name\" $icon $exec\n";
  1672.         }
  1673.         elsif ($entry->{type} eq 'menu')
  1674.         {
  1675.             $output .= output_icewm_menu ($entry->{'menu'}, $indent + 1);
  1676.         }
  1677.         else
  1678.         {
  1679.             print STDERR "wrong menu entry type: $entry->{type}";
  1680.         }
  1681.  
  1682.     }
  1683.  
  1684.     if($indent)
  1685.     {
  1686.     $output .= ' ' x $indent;
  1687.     $output .= "}\n";
  1688.     }
  1689.  
  1690.     return $output;
  1691. }
  1692.  
  1693.  
  1694.  
  1695. sub output_ion3_menu ($;$)
  1696. {
  1697.     my ($menu, $indent) = @_;
  1698.  
  1699.     my $output = '';
  1700.  
  1701.     my @pending_list = ();
  1702.  
  1703.     $indent = 0 unless defined $indent;
  1704.  
  1705.     my $menu_name = $menu->{'PrepName'};
  1706.  
  1707.     $output .= ' ' x $indent;
  1708.     $output = "defmenu(\"".$menu_name."\", {\n";
  1709.  
  1710.     foreach my $entry (@{$menu->{'entries'}})
  1711.     {
  1712.         if ($entry->{type} eq 'desktop')
  1713.         {
  1714.             my $desktop = $entry->{desktop};
  1715.  
  1716.             my $name = $desktop->{'PrepName'};
  1717.             my $exec = $desktop->{'PrepExec'};
  1718.  
  1719.         $exec =~ s/"/\\"/g;
  1720.  
  1721.             $output .= ' ' x $indent;
  1722.             $output .= "    menuentry(\"$name\", \"ioncore.exec_on(_, '$exec')\"),\n";
  1723.         }
  1724.         elsif ($entry->{type} eq 'menu')
  1725.         {
  1726.             push @pending_list, $entry;
  1727.             $output .= "    submenu(\"".$entry->{'menu'}->{'PrepName'}."\", \"".$entry->{'menu'}->{'PrepName'}."\"),\n";
  1728.         }
  1729.         else
  1730.         {
  1731.             print STDERR "wrong menu entry type: $entry->{type}";
  1732.         }
  1733.  
  1734.     }
  1735.     $output .= ' ' x $indent;
  1736.     $output .= "})\n";
  1737.  
  1738.     foreach my $entry (@pending_list)
  1739.     {
  1740.         $output .= output_ion3_menu ($entry->{'menu'}, $indent + 1);
  1741.     }
  1742.  
  1743.     return $output;
  1744. }
  1745.  
  1746. sub output_awesome_menu ($;$)
  1747. {
  1748.     my ($menu, $indent) = @_;
  1749.  
  1750.     my $output = '';
  1751.  
  1752.     my @pending_list = ();
  1753.  
  1754.     $indent = 0 unless defined $indent;
  1755.  
  1756.     my $menu_name = "menu".md5_hex($menu->{'PrepName'});
  1757.     if($indent == 0)
  1758.     {
  1759.         $menu_name = "xdgmenu";
  1760.     }
  1761.  
  1762.     #my $menu_icon = findicon($menu->{'PrepIcon'}) || "folder";
  1763.  
  1764.     foreach my $entry (@{$menu->{'entries'}})
  1765.     {
  1766.         if ($entry->{type} eq 'menu')
  1767.         {
  1768.             push @pending_list, $entry;
  1769.         }
  1770.     }
  1771.  
  1772.     foreach my $entry (@pending_list)
  1773.     {
  1774.         $output .= output_awesome_menu ($entry->{'menu'}, $indent + 1);
  1775.     }
  1776.  
  1777.     $output .= ' ' x $indent;
  1778.     if($indent == 1)
  1779.     {
  1780.       $output .= 'local ';
  1781.     }
  1782.     $output .= $menu_name." = {\n";
  1783.  
  1784.     foreach my $entry (@{$menu->{'entries'}})
  1785.     {
  1786.         if ($entry->{type} eq 'desktop')
  1787.         {
  1788.             my $desktop = $entry->{desktop};
  1789.  
  1790.             my $name = $desktop->{'PrepName'};
  1791.             my $exec = $desktop->{'PrepExec'};
  1792.             my $icon = findicon($desktop->{'Icon'}) || "-";
  1793.  
  1794.             $exec =~ s/"/\\"/g;
  1795.  
  1796.             $output .= ' ' x $indent;
  1797.         if ($icon eq "-") {
  1798.               $output .= "    {\"$name\", \"$exec\"},\n";
  1799.         } else {
  1800.               $output .= "    {\"$name\", \"$exec\", \"$icon\" },\n";
  1801.         }
  1802.         }
  1803.         elsif ($entry->{type} eq 'menu')
  1804.         {
  1805.             $output .= "    {\"".$entry->{'menu'}->{'PrepName'}."\", "."menu".md5_hex($entry->{'menu'}->{'PrepName'})."},\n";
  1806.         }
  1807.         else
  1808.         {
  1809.             print STDERR "wrong menu entry type: $entry->{type}";
  1810.         }
  1811.  
  1812.     }
  1813.     $output .= ' ' x $indent;
  1814.     $output .= "}\n\n";
  1815.  
  1816.     return $output;
  1817. }
  1818.  
  1819. sub output_twm_menu ($;$)
  1820. {
  1821.     my ($menu, $indent) = @_;
  1822.  
  1823.     my $output = '';
  1824.  
  1825.     my @pending_list = ();
  1826.  
  1827.     $indent = 0 unless defined $indent;
  1828.  
  1829.     my $menu_name = $menu->{'PrepName'};
  1830.  
  1831.     $output .= ' ' x $indent;
  1832.     $output = "menu \"".$menu_name."\"\n{\n";
  1833.  
  1834.     foreach my $entry (@{$menu->{'entries'}})
  1835.     {
  1836.         if ($entry->{type} eq 'desktop')
  1837.         {
  1838.             my $desktop = $entry->{desktop};
  1839.  
  1840.             my $name = $desktop->{'PrepName'};
  1841.             my $exec = $desktop->{'PrepExec'};
  1842.  
  1843.         $exec =~ s/"/\\"/g;
  1844.  
  1845.             $output .= ' ' x $indent;
  1846.             $output .= "    \"$name\"  f.exec \"exec $exec &\"\n";
  1847.         }
  1848.         elsif ($entry->{type} eq 'menu')
  1849.         {
  1850.             push @pending_list, $entry;
  1851.             $output .= "    \"".$entry->{'menu'}->{'PrepName'}."\"  f.menu \"".$entry->{'menu'}->{'PrepName'}."\"\n";
  1852.         }
  1853.         else
  1854.         {
  1855.             print STDERR "wrong menu entry type: $entry->{type}";
  1856.         }
  1857.  
  1858.     }
  1859.     $output .= ' ' x $indent;
  1860.     $output .= "}\n";
  1861.  
  1862.     foreach my $entry (@pending_list)
  1863.     {
  1864.         $output .= output_twm_menu ($entry->{'menu'}, $indent + 1);
  1865.     }
  1866.  
  1867.     return $output;
  1868. }
  1869.  
  1870. sub prepare_exec_xfce4 ($$)
  1871. {
  1872.     my ($exec, $desktop) = @_;
  1873.  
  1874.     $exec =~ s/%f//g;
  1875.     $exec =~ s/%F//g;
  1876.     $exec =~ s/%u//g;
  1877.     $exec =~ s/%U//g;
  1878.     $exec =~ s/%d//g;
  1879.     $exec =~ s/%D//g;
  1880.     $exec =~ s/%n//g;
  1881.     $exec =~ s/%N//g;
  1882.     $exec =~ s/%i//g;
  1883.     $exec =~ s/%k//g;
  1884.     $exec =~ s/%v//g;
  1885.     $exec =~ s/%m//g;
  1886.  
  1887.     my $caption = $desktop->{Name};
  1888.  
  1889.     $exec =~ s/%c/$caption/g;
  1890.  
  1891.     $exec =~ s/%%/%/g;
  1892.  
  1893.     $exec =~ s/\"/&quot;/g;
  1894.  
  1895.     $exec = "$root_cmd $exec" if $desktop->{'X-KDE-SubstituteUID'} eq '1' || $desktop->{'X-KDE-SubstituteUID'} eq 'true';
  1896.     return $exec;
  1897. }
  1898.  
  1899.  
  1900.  
  1901. sub output_xfce4_menu ($;$)
  1902. {
  1903.     my ($menu, $indent) = @_;
  1904.  
  1905.     my $output = '';
  1906.  
  1907.     $indent = 0 unless defined $indent;
  1908.  
  1909.     if ($indent == 0)
  1910.     {
  1911.         $output .= '<?xml version="1.0" encoding="UTF-8"?>' . "\n";
  1912.         $output .= '<!DOCTYPE xfdesktop-menu [' . "\n";
  1913.         $output .= '    <!ENTITY menu2 SYSTEM "menu2.xml">' . "\n";
  1914.         $output .= ']>' . "\n\n";
  1915.     }
  1916.  
  1917.     my $menu_name = $menu->{'PrepName'};
  1918.  
  1919.     $output .= ' ' x $indent;
  1920.  
  1921.     if ($indent == 0)
  1922.     {
  1923.         $output .= "<xfdesktop-menu>\n"
  1924.     }
  1925.     else
  1926.     {
  1927.         $output .= "<menu name=\"" . quote_xml($menu_name) ."\" visible=\"yes\">\n";
  1928.     }
  1929.  
  1930.     foreach my $entry (@{$menu->{'entries'}})
  1931.     {
  1932.         if ($entry->{type} eq 'desktop')
  1933.         {
  1934.             my $desktop = $entry->{desktop};
  1935.  
  1936.             my $name = $desktop->{'PrepName'};
  1937.             my $exec = prepare_exec_xfce4($desktop->{Exec}, $desktop);
  1938.             my $term = ($desktop->{Terminal} eq '1' || $desktop->{Terminal} eq 'true') ? "yes" : "no";
  1939.  
  1940.             $output .= ' ' x $indent;
  1941.             $output .= " <app name=\"" . quote_xml($name) ."\" cmd=\"$exec\" term=\"$term\"/>\n";
  1942.         }
  1943.         elsif ($entry->{type} eq 'menu')
  1944.         {
  1945.             $output .= output_xfce4_menu ($entry->{'menu'}, $indent + 1);
  1946.         }
  1947.         else
  1948.         {
  1949.             print STDERR "wrong menu entry type: $entry->{type}";
  1950.         }
  1951.  
  1952.     }
  1953.     $output .= ' ' x $indent;
  1954.  
  1955.     if ($indent == 0)
  1956.     {
  1957.         $output .= "</xfdesktop-menu>\n";
  1958.     }
  1959.     else
  1960.     {
  1961.         $output .= "</menu>\n";
  1962.     }
  1963.  
  1964.     return $output;
  1965. }
  1966.  
  1967. sub output_openbox3_menu ($;$)
  1968. {
  1969.     my ($menu, $indent) = @_;
  1970.  
  1971.     my $output = '';
  1972.  
  1973.     $output .= '<?xml version="1.0" encoding="UTF-8"?>
  1974.  
  1975. <openbox_menu xmlns="http://openbox.org/"
  1976.        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
  1977.        xsi:schemaLocation="http://openbox.org/
  1978.                file:///usr/share/openbox/menu.xsd">';
  1979.     $output .= "<menu id=\"xdg\" label=\"xdg\">\n";
  1980.     $output .= output_openbox3_inner_menu ($menu, $indent);
  1981.     $output .= "</menu>\n";
  1982.     $output .= '    <menu id="root-menu" label="Openbox 3">
  1983. <item label="xterm">
  1984. <action name="Execute"><execute>xterm</execute></action> </item>
  1985. <separator />
  1986. <menu id="KDE Menu" label="KDE Menu" />
  1987. <separator />
  1988. <menu id="client-list-menu" />
  1989. <separator />
  1990. <menu id="ob-menu" label="openbox3">
  1991.     <item label="ob conf"><action name="Execute"><execute>obconf</execute></action></item>
  1992.     <item label="reconfigure"><action name="Reconfigure" /></item>
  1993. </menu>
  1994. <separator />
  1995. <item label="lock screen"><action name="Execute"><execute>xlock -remote -nice 19 -mode blank -geometry 1x1 -enablesaver</execute></action></item>
  1996. <separator />
  1997. <item label="Exit"><action name="Exit" /></item>
  1998. </menu>';
  1999.     $output .= "</openbox_menu>\n";
  2000.     return $output;
  2001. }
  2002.  
  2003. sub output_openbox3_pipe_menu ($;$)
  2004. {
  2005.     my ($menu, $indent) = @_;
  2006.  
  2007.     my $output = '';
  2008.  
  2009.     $output .= "<openbox_pipe_menu>\n";
  2010.     $output .= output_openbox3_inner_menu ($menu, $indent);
  2011.     $output .= "</openbox_pipe_menu>\n";
  2012.     return $output;
  2013. }
  2014.  
  2015. sub output_openbox3_inner_menu ($;$)
  2016. {
  2017.     my ($menu, $indent) = @_;
  2018.  
  2019.     my $output = '';
  2020.  
  2021.     $indent = 0 unless defined $indent;
  2022.     my $menu_name = $menu->{'PrepName'};
  2023.     my $menu_icon = findicon($menu->{'PrepIcon'});
  2024.  
  2025.     if($indent != 0)
  2026.     {
  2027.     $output .= ' ' x $indent;
  2028.  
  2029.         if ($menu_icon eq "")
  2030.         {
  2031.             $output .= "<menu id=\"" . quote_xml($menu_name) . "\" label=\"".quote_xml($menu_name) . "\">\n";
  2032.         }
  2033.         else
  2034.         {
  2035.             $output .= "<menu id=\"" . quote_xml($menu_name) . "\" label=\"".quote_xml($menu_name) . "\" icon=\"" . quote_xml($menu_icon) . "\">\n";
  2036.         }
  2037.  
  2038. #       $output .= "<menu label=\"".quote_xml($menu_name) . "\">\n";
  2039.     }
  2040.  
  2041.     foreach my $entry (@{$menu->{'entries'}})
  2042.     {
  2043.         if ($entry->{type} eq 'desktop')
  2044.         {
  2045.             my $desktop = $entry->{desktop};
  2046.  
  2047.             my $name = $desktop->{'PrepName'};
  2048.             my $exec = $desktop->{'PrepExec'};
  2049.             my $icon = findicon($desktop->{'Icon'});
  2050.  
  2051.             $output .= ' ' x $indent;
  2052.  
  2053.             if ($icon eq "")
  2054.             {
  2055.                 $output .= "     <item label=\"". quote_xml($name)."\">\n";
  2056.             }
  2057.             else
  2058.             {
  2059.                 $output .= "     <item label=\"". quote_xml($name)."\" icon=\"" . quote_xml($icon) . "\">\n";
  2060.             }
  2061.  
  2062.             $output .= "       <action name=\"Execute\"><execute>$exec</execute></action>\n";
  2063.             $output .= "     </item>\n";
  2064.         }
  2065.         elsif ($entry->{type} eq 'menu')
  2066.         {
  2067.             $output .= output_openbox3_inner_menu ($entry->{'menu'}, $indent + 1);
  2068.         }
  2069.         else
  2070.         {
  2071.             print STDERR "wrong menu entry type: $entry->{type}";
  2072.         }
  2073.     }
  2074.  
  2075.     if($indent != 0)
  2076.     {
  2077.     $output .= ' ' x $indent;
  2078.     $output .= "</menu> <!-- $menu_name -->\n";
  2079.     }
  2080.  
  2081.     return $output;
  2082. }
  2083.  
  2084.  
  2085. sub output_readable ($;$)
  2086. {
  2087.     my ($menu, $indent) = @_;
  2088.  
  2089.     my $output = '';
  2090.  
  2091.     $indent = 0 unless defined $indent;
  2092.  
  2093.     my $menu_name = $menu->{'Name'};
  2094.  
  2095.     $output .= "\t" x $indent;
  2096.     $output .= "\"$menu_name\" MENU\n";
  2097.  
  2098.  
  2099.     foreach my $entry (@{$menu->{'entries'}})
  2100.     {
  2101.         if ($entry->{type} eq 'desktop') {
  2102.             my $desktop = $entry->{desktop};
  2103.  
  2104.             my $name = $desktop->{Name};
  2105.  
  2106.             $output .= "\t" x $indent;
  2107.             $output .= "\t\"$name\"\n";
  2108.  
  2109.  
  2110.             my @v = %$desktop;
  2111.             $output .= "@v\n" if $name  eq '';
  2112.         }
  2113.         elsif ($entry->{type} eq 'menu')
  2114.         {
  2115.             $output .= output_readable ($entry->{menu}, $indent + 1);
  2116.         }
  2117.         else
  2118.         {
  2119.             print STDERR "wrong menu entry type: $entry->{type}";
  2120.         }
  2121.  
  2122.     }
  2123.  
  2124.     return $output;
  2125. }
  2126.  
  2127. sub output_jwm_inner_menu ($;$)
  2128. {
  2129.     my ($menu, $indent) = @_;
  2130.  
  2131.     my $output = '';
  2132.  
  2133.     $indent = 0 unless defined $indent;
  2134.  
  2135.     my $menu_name = $menu->{'PrepName'};
  2136.     #my $menu_icon = $menu->{'PrepIcon'} || "folder" ;
  2137.     my $menu_icon = findicon($menu->{'PrepIcon'}) || "folder";
  2138.  
  2139.     if($indent)
  2140.     {
  2141.     $output .= ' ' x $indent;
  2142.     $output .= "<Menu icon=\"$menu_icon\" label=\"$menu_name\">\n";
  2143.     }
  2144.  
  2145.     foreach my $entry (@{$menu->{'entries'}})
  2146.     {
  2147.         if ($entry->{type} eq 'desktop')
  2148.         {
  2149.             my $desktop = $entry->{desktop};
  2150.  
  2151.             my $name = $desktop->{'PrepName'};
  2152.             my $exec = $desktop->{'PrepExec'};
  2153.             my $icon = findicon($desktop->{'Icon'}) || "";
  2154.  
  2155.             $output .= ' ' x $indent;
  2156.             $output .= " <Program icon=\"$icon\" label=\"$name\">$exec</Program>\n";
  2157.         }
  2158.         elsif ($entry->{type} eq 'menu')
  2159.         {
  2160.             $output .= output_jwm_inner_menu ($entry->{'menu'}, $indent + 1);
  2161.         }
  2162.         else
  2163.         {
  2164.             print STDERR "wrong menu entry type: $entry->{type}";
  2165.         }
  2166.  
  2167.     }
  2168.  
  2169.     if($indent)
  2170.     {
  2171.     $output .= ' ' x $indent;
  2172.     $output .= "</Menu>\n";
  2173.     }
  2174.  
  2175.     return $output;
  2176. }
  2177.  
  2178. sub output_jwm_menu ($;$)
  2179. {
  2180.     my ($menu, $indent) = @_;
  2181.  
  2182.     my $output = '';
  2183.  
  2184.     $output .= "<JWM>\n";
  2185.     $output .= output_jwm_inner_menu ($menu, $indent);
  2186.     $output .= "</JWM>\n";
  2187.     return $output;
  2188. }
  2189.  
  2190. sub get_root_menu
  2191. {
  2192.     foreach my $dir (split(/:/, $ENV{XDG_CONFIG_DIRS}), "/etc/xdg")
  2193.     {
  2194.         check_file("$dir/menus/arch-applications.menu");
  2195.         return "$dir/menus/arch-applications.menu" if -f "$dir/menus/arch-applications.menu";
  2196.     }
  2197.     return "";
  2198. }
  2199.  
  2200. sub get_kde_config
  2201. {
  2202.     my $ret = 'true';
  2203.     if(-x '/usr/bin/kde4-config')
  2204.     {
  2205.         $ret = '/usr/bin/kde4-config';
  2206.     }
  2207.     elsif(-x '/opt/kde/bin/kde-config')
  2208.     {
  2209.         $ret = '/opt/kde/bin/kde-config';
  2210.     }
  2211.     return $ret;
  2212. }
  2213.  
  2214. sub get_app_dirs
  2215. {
  2216.     my %used;
  2217.     my $ret = '';
  2218.  
  2219.  
  2220.     my @kde_xdgdata = split(/:/, `$kdeconfig --path xdgdata-apps`);
  2221.  
  2222.     foreach $_ (@kde_xdgdata)
  2223.     {
  2224.         s/\/applications\/*\s*$//;
  2225.     };
  2226.  
  2227.     foreach my $d (split(/:/, $ENV{XDG_DATA_DIRS}), @kde_xdgdata, "/usr/share", "/opt/gnome/share")
  2228.     {
  2229.         my $dir = $d;
  2230.         $dir =~ s/\/*$//;
  2231.         next if defined $used{$dir};
  2232.         next if check_file("$dir/applications") ne 'D';
  2233.         $ret .= ':' if $ret ne '';
  2234.         $ret .= "$dir/applications";
  2235.         $used{$dir} = 1;
  2236.     }
  2237.     return $ret;
  2238. }
  2239.  
  2240. sub get_desktop_dirs
  2241. {
  2242.     my %used;
  2243.     my $ret = '';
  2244.     foreach my $dir (split(/:/, $ENV{XDG_DATA_DIRS}), "/usr/share", "/opt/kde3/share", "/opt/gnome/share")
  2245.     {
  2246.         next if defined $used{$dir};
  2247.         next if check_file("$dir/desktop-directories") ne 'D';
  2248.         $ret .= ':' if $ret ne '';
  2249.         $ret .= "$dir/desktop-directories";
  2250.         $used{$dir} = 1;
  2251.     }
  2252.     return $ret;
  2253. }
  2254.  
  2255. sub get_KDE_legacy_dirs
  2256. {
  2257.     my %used;
  2258.     my @ret;
  2259.     foreach my $d ("/etc/opt/kde3/share/applnk", "/opt/kde3/share/applnk", reverse(split(/:/, `$kdeconfig --path apps`)))
  2260.     {
  2261.         my $dir = $d;
  2262.         chomp $dir;
  2263.         $dir =~ s/\/*$//;
  2264.         next if defined $used{$dir};
  2265.         next if check_file("$dir") ne 'D';
  2266.         $used{$dir} = 1;
  2267.         push @ret, $dir;
  2268.     }
  2269.     return @ret;
  2270. }
  2271.  
  2272. sub prepare_language_keys ($)
  2273. {
  2274.     my ($language) = @_;
  2275.  
  2276.     my @keys;
  2277.  
  2278.     $language =~ s/\.[^@]*//;  # remove .ENCODING
  2279.  
  2280.     if ($language =~ /^([^_]*)_([^@]*)@(.*)$/)
  2281.     { # LANG_COUNTRY@MODIFIER
  2282.         push @keys, $1 . '_' . $2 . '@' . $3;
  2283.         push @keys, $1 . '_' . $2;
  2284.         push @keys, $1 . '@' . $3;
  2285.         push @keys, $1;
  2286.     }
  2287.     elsif ($language =~ /^([^_]*)_([^@]*)$/)
  2288.     { # LANG_COUNTRY
  2289.         push @keys, $1 . '_' . $2;
  2290.         push @keys, $1;
  2291.     }
  2292.     elsif ($language =~ /^([^_]*)@(.*)$/)
  2293.     { # LANG@MODIFIER
  2294.         push @keys, $1 . '@' . $2;
  2295.         push @keys, $1;
  2296.     }
  2297.     elsif ($language =~ /^([^_@]*)$/)
  2298.     { # LANG
  2299.         push @keys, $1;
  2300.     }
  2301.  
  2302.     return @keys;
  2303. }
  2304.  
  2305. sub get_cache_dir
  2306. {
  2307.     my $ret;
  2308.     if($ENV{XDG_CACHE_HOME})
  2309.     {
  2310.         $ret = "$ENV{XDG_CACHE_HOME}/xdg_menu";
  2311.     }
  2312.     else
  2313.     {
  2314.         $ret = "$ENV{HOME}/.xdg_menu_cache";
  2315.     }
  2316.     return $ret;
  2317. }
  2318.  
  2319. sub check_cache
  2320. {
  2321.     my $cachedir = get_cache_dir;
  2322.  
  2323.     return unless -f "$cachedir/inputs" && -f "$cachedir/output";
  2324.  
  2325.     my @st = stat "$cachedir/output";
  2326.     my $ref_time = $st[10]; #ctime
  2327.  
  2328.     open(FILE, "<$cachedir/inputs");
  2329.  
  2330.     my $num_opts = 0;
  2331.  
  2332.     while (<FILE>)
  2333.     {
  2334.         chomp;
  2335.         next if /^\s*$/;
  2336.         next if /^#/;
  2337.  
  2338.             if (/^[FD] (.*)$/)
  2339.         {
  2340.             my $file = $1;
  2341.             my @st = stat $file;
  2342.             my $time = $st[10]; #ctime
  2343.  
  2344.             if (!defined $time || $time >= $ref_time)
  2345.             {
  2346. #               print STDERR "$file: is newer\n";
  2347.                 return;
  2348.             }
  2349.         }
  2350.         elsif (/^X (.*)$/)
  2351.         {
  2352.             my $file = $1;
  2353.  
  2354.             if (-e $file) {
  2355. #               print STDERR "$file: exists\n";
  2356.                 return;
  2357.             }
  2358.         }
  2359.         elsif (/^ENV ([^ ]+) (.*)$/)
  2360.         {
  2361.             my $var = $1;
  2362.             my $val = $2;
  2363.  
  2364.             if ($ENV{$var} ne $val)
  2365.             {
  2366. #               print STDERR "$var: differs\n";
  2367.                 return;
  2368.             }
  2369.         }
  2370.         elsif (/^OPT ([0-9]+) (.*)$/)
  2371.         {
  2372.             my $optidx = $1;
  2373.             my $val = $2;
  2374.  
  2375.             $num_opts ++;
  2376.             if ($save_ARGV[$optidx] ne $val)
  2377.             {
  2378. #               print STDERR "$optidx: differs\n";
  2379.                 return;
  2380.             }
  2381.         }
  2382.         elsif (/^CHARSET (.*)$/)
  2383.         {
  2384.             my $charset = $1;
  2385.  
  2386.             if ($charset ne langinfo(CODESET))
  2387.             {
  2388. #               print STDERR "charset $charset differs\n";
  2389.                 return;
  2390.             }
  2391.         }
  2392.         elsif (/^LANGUAGE (.*)$/)
  2393.         {
  2394.             my $language = $1;
  2395.  
  2396.             if ($language ne setlocale(LC_MESSAGES))
  2397.             {
  2398. #               print STDERR "language $language differs\n";
  2399.                 return;
  2400.             }
  2401.         }
  2402.         elsif (/^VERSION (.*)$/)
  2403.         {
  2404.             my $v = $1;
  2405.  
  2406.             if ($v ne $Version) {
  2407. #               print STDERR "Version differs\n";
  2408.                 return;
  2409.             }
  2410.         }
  2411.         else {
  2412.             print STDERR "Wrong cache inputs list\n";
  2413.             return;
  2414.         }
  2415.  
  2416.  
  2417.     }
  2418.  
  2419.     return if $num_opts != @save_ARGV;
  2420.  
  2421.     open(FILE, "<$cachedir/output") or return;
  2422.  
  2423.     print STDERR "Using cached output\n" if $verbose;
  2424.  
  2425.     my $buf;
  2426.     while(read(FILE, $buf, 4096))
  2427.     {
  2428.         print $buf;
  2429.     }
  2430.     close(FILE);
  2431.  
  2432.     exit 0;
  2433. }
  2434.  
  2435. sub write_cache ($)
  2436. {
  2437.     my ($output) = @_;
  2438.     my $cachedir = get_cache_dir;
  2439.  
  2440.     mkdir $cachedir;
  2441.     unlink "$cachedir/output";
  2442.  
  2443.     open(FILE, ">$cachedir/inputs") or return;
  2444.     print FILE "# this file contains list of inputs xdg_menu\n";
  2445.     print FILE "VERSION $Version\n";
  2446.     print FILE "\n\n";
  2447.     print FILE join("\n",  @accessed_files);
  2448.     print FILE "\n\n";
  2449.  
  2450.     for (my $i = 0; $i < @save_ARGV; $i++)
  2451.     {
  2452.         print FILE "OPT $i $save_ARGV[$i]\n";
  2453.     }
  2454.  
  2455.     print FILE "ENV XDG_CONFIG_DIRS $ENV{XDG_CONFIG_DIRS}\n";
  2456.     print FILE "ENV XDG_DATA_DIRS $ENV{XDG_DATA_DIRS}\n";
  2457.  
  2458.     print FILE "CHARSET " . langinfo(CODESET) . "\n";
  2459.     print FILE "LANGUAGE " . setlocale(LC_MESSAGES) . "\n";
  2460.  
  2461.     close(FILE);
  2462.     open(FILE, ">$cachedir/output") or return;
  2463.     print FILE $output;
  2464.     close(FILE);
  2465. }
  2466.  
  2467.  
  2468. #
  2469. # ################################################
  2470. #
  2471.  
  2472. check_cache();
  2473.  
  2474. use XML::Parser;
  2475.  
  2476. $DefaultAppDirs = get_app_dirs();
  2477. $DefaultDirectoryDirs = get_desktop_dirs();
  2478.  
  2479. my $root_menu = get_root_menu();
  2480.  
  2481. @KDELegacyDirs = get_KDE_legacy_dirs();
  2482.  
  2483. $charset = langinfo(CODESET);
  2484. $language = setlocale(LC_MESSAGES);
  2485.  
  2486. $root_cmd = "/opt/gnome/bin/gnomesu" if -x '/opt/gnome/bin/gnomesu';
  2487. $root_cmd = "/opt/kde3/bin/kdesu" if -x '/opt/kde3/bin/kdesu';
  2488.  
  2489. my $help;
  2490.  
  2491. GetOptions("format=s" => \$format,
  2492.            "fullmenu" => \$fullmenu,
  2493.            "desktop=s" => \$desktop_name,
  2494.            "charset=s" => \$charset,
  2495.            "language=s" => \$language,
  2496.            "root-menu=s" => \$root_menu,
  2497.            "die-on-error" => \$die_on_error,
  2498.            "verbose" => \$verbose,
  2499.            "help" => \$help
  2500.     );
  2501.  
  2502. @language_keys = prepare_language_keys($language);
  2503.  
  2504. $desktop_name = $format unless defined $desktop_name;
  2505.  
  2506. if ($help)
  2507. {
  2508.     print <<"EOF";
  2509.  
  2510.     xdg-menu - XDG menus for WindowMaker and other window managers
  2511.       http://freedesktop.org/Standards/menu-spec
  2512.  
  2513.  
  2514.     Usage:
  2515.       xdg_menu [--format <format>] [--desktop <desktop>]
  2516.       [--charset <charset>] [--language <language>]
  2517.       [--root-menu <root-menu>] [--die-on-error]
  2518.       [--fullmenu] [--help]
  2519.  
  2520.       format - output format
  2521.  
  2522.       possible formats: twm, WindowMaker, fvwm2, icewm,  ion3,
  2523.                         blackbox, fluxbox, openbox,
  2524.                         xfce4, openbox3, openbox3-pipe, awesome
  2525.                         jwm, readable
  2526.                         default: WindowMaker
  2527.  
  2528.       fullmenu  - output a full menu and not only a submenu
  2529.  
  2530.       desktop - desktop name for NotShowIn and OnlyShowIn
  2531.                 default: the same as format
  2532.  
  2533.       charset - output charset
  2534.                 default: $charset
  2535.  
  2536.       language - output language
  2537.                  default: $language
  2538.  
  2539.       root-menu - location of root menu file
  2540.                   default: $root_menu
  2541.  
  2542.       die-on-error - abort execution on any error,
  2543.                      default: try to continue
  2544.  
  2545.       verbose - print debugging information
  2546.  
  2547.       help - print this text
  2548.  
  2549. EOF
  2550.  exit 0;
  2551. }
  2552.  
  2553.  
  2554. unless ( -f $root_menu)
  2555. {
  2556.     print STDERR "Can't find root menu file.\n";
  2557.     exit 1;
  2558. }
  2559.  
  2560. my $tree = read_menu($root_menu);
  2561.  
  2562. merge_menus($tree);
  2563. move_menus($tree);
  2564.  
  2565. my $menu = interpret_root($tree, '');
  2566.  
  2567. remove_allocated($menu);
  2568. preprocess_menu($menu);
  2569. remove_empty_menus($menu);
  2570.  
  2571. my $output;
  2572.  
  2573. if ($format eq 'WindowMaker')
  2574. {
  2575.     $output = output_wmaker_menu($menu)
  2576. }
  2577. elsif ($format eq 'fvwm2')
  2578. {
  2579.     $output = output_fvwm2_menu($menu)
  2580. }
  2581. elsif ($format eq 'icewm')
  2582. {
  2583.     $output = output_icewm_menu($menu)
  2584. }
  2585. elsif ($format eq 'ion3')
  2586. {
  2587.     $output = output_ion3_menu($menu);
  2588. }
  2589. elsif ($format eq 'awesome')
  2590. {
  2591.     $output = output_awesome_menu($menu);
  2592. }
  2593. elsif ($format eq 'twm')
  2594. {
  2595.     $output = output_twm_menu($menu);
  2596. }
  2597. elsif ($format eq 'xfce4')
  2598. {
  2599.     $output = output_xfce4_menu($menu)
  2600. }
  2601. elsif ($format eq 'blackbox' || ($format eq 'openbox') || ($format eq 'fluxbox') )
  2602. {
  2603.     if ($fullmenu)
  2604.     {
  2605.         $output = output_blackbox_menu($menu)
  2606.     }
  2607.     else
  2608.     {
  2609.         $output = output_blackbox_inner_menu($menu)
  2610.     }
  2611. }
  2612. elsif ($format eq 'openbox3')
  2613. {
  2614.     if ($fullmenu)
  2615.     {
  2616.         $output = output_openbox3_menu($menu)
  2617.     }
  2618.     else
  2619.     {
  2620.         $output = output_openbox3_inner_menu($menu)
  2621.     }
  2622. }
  2623. elsif ($format eq 'openbox3-pipe')
  2624. {
  2625.     $output = output_openbox3_pipe_menu($menu)
  2626. }
  2627. elsif ($format eq 'jwm')
  2628. {
  2629.     if ($fullmenu)
  2630.     {
  2631.         $output = output_jwm_menu($menu)
  2632.     }
  2633.     else
  2634.     {
  2635.         $output = output_jwm_inner_menu($menu)
  2636.     }
  2637. }
  2638. elsif ($format eq 'readable')
  2639. {
  2640.     $output = output_readable($menu)
  2641. }
  2642. else
  2643. {
  2644.     print STDERR "Unknown format $format\n";
  2645.     exit 1;
  2646. }
  2647.  
  2648. print $output;
  2649. write_cache($output);
  2650.  
  2651. exit 0;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!