#!/usr/bin/perl # Copyright (c) 2003 SuSE Linux AG, Nuernberg, Germany. All rights reserved. # # Author: nadvornik@suse.cz # # use strict; use Locale::gettext; use Getopt::Long; use Encode; use I18N::Langinfo qw(langinfo CODESET); use POSIX qw(locale_h); my $Version = "0.2"; my $DefaultAppDirs; my $DefaultDirectoryDirs; my @KDELegacyDirs; my $format = 'WindowMaker'; my $desktop_name; my $language = ''; my $charset = 'iso-8859-1'; my $root_cmd = 'xdg_menu_su'; my $die_on_error = 0; my $verbose = 0; my $fullmenu = 0; my @language_keys; my @accessed_files; my @save_ARGV = @ARGV; my %Desktop_entries; my %Directory_entries; sub check_file ($) { my ($file) =@_; unless (-e $file) { push @accessed_files, "X $file"; return ''; } if (-d $file) { push @accessed_files, "D $file"; return 'D'; } else { push @accessed_files, "F $file"; return 'F'; } } sub add_png_extension_if_needed ($) { my ($f) = @_; return $f =~ /\.(png|xpm|svg)$/ ? $f : "$f.png"; } sub scan_AppDir ($$;$) { my ($pool, $dir, $topdir) = @_; check_file($dir); $topdir = $dir unless defined $topdir; opendir(DIR, $dir) or return; foreach my $entry (readdir(DIR)) { if ( -f "$dir/$entry" && $entry =~ /\.desktop$/ ) { read_desktop_entry($pool, "$dir/$entry", $topdir); } elsif ( -d "$dir/$entry" && $entry ne '.' && $entry ne '..' && $entry ne '.hidden') { scan_AppDir ($pool, "$dir/$entry", $topdir); } } closedir DIR; } sub scan_DirectoryDir ($$;$) { my ($pool, $dir, $topdir) = @_; check_file($dir); $topdir = $dir unless defined $topdir; opendir(DIR, $dir) or return; foreach my $entry (readdir(DIR)) { if ( -f "$dir/$entry" && $entry =~ /\.directory$/ ) { read_directory_entry($pool, "$dir/$entry", $topdir); } elsif ( -d "$dir/$entry" && $entry ne '.' && $entry ne '..' && $entry ne '.hidden') { scan_DirectoryDir ($pool, "$dir/$entry", $topdir); } } closedir DIR; } sub read_directory_entry { my ($pool, $file, $topdir) = @_; unless (defined $Directory_entries{$file}) { check_file($file); open(FILE, "<$file") or return; my $in_desktop_entry = 0; my %entry; while () { if (/^\[/) { if (/^\[Desktop Entry\]/) { $in_desktop_entry = 1; } elsif (/^\[.*\]/) { $in_desktop_entry = 0; } } elsif ($in_desktop_entry && /^([^=]*)=([^[:cntrl:]]*)/) { $entry{$1} = $2; } } close(FILE); my $id = $file; $id =~ s/^$topdir//; $id =~ s/^\/*//; $id =~ s/\//-/g; $entry{'id'} = $id; $Directory_entries{$file} = \%entry; } my $entry = $Directory_entries{$file}; $pool->{'Directory_entries'}{$entry->{'id'}} = $entry; } sub check_show_in ($) { my ($entry) = @_; return 1 unless defined $entry; my %OnlyShowIn; my %NotShowIn; if (defined $entry->{'OnlyShowIn'}) { foreach my $showin (split /;/, $entry->{'OnlyShowIn'}) { $OnlyShowIn{$showin} = 1; } return 0 unless defined $OnlyShowIn{$desktop_name}; } if (defined $entry->{'NotShowIn'}) { foreach my $showin (split /;/, $entry->{'NotShowIn'}) { $NotShowIn{$showin} = 1; } return 0 if defined $NotShowIn{$desktop_name} ; } return 1; } sub read_desktop_entry { my ($pool, $file, $topdir) = @_; unless (defined $Desktop_entries{$file}) { check_file($file); open(FILE, "<$file") or return; my $in_desktop_entry = 0; my %entry; while () { if (/^\[/) { if (/^\[Desktop Entry\]/) { $in_desktop_entry = 1; } elsif (/^\[.*\]/) { $in_desktop_entry = 0; } } elsif ($in_desktop_entry && /^([^=]*)=([^[:cntrl:]]*)/) { $entry{$1} = $2; } } close(FILE); my $id = $file; $id =~ s/^$topdir//; $id =~ s/^\/*//; $id =~ s/\//-/g; $entry{'id'} = $id; $entry{'refcount'} = 0; $Desktop_entries{$file} = \%entry; } my $entry = $Desktop_entries{$file}; return unless defined $entry->{'Name'}; return unless defined $entry->{'Exec'}; return if $entry->{'Hidden'} eq 'true'; return if $entry->{'NoDisplay'} eq 'true'; return unless check_show_in($entry); return if defined $entry->{'NotShowIn'} && $entry->{'NotShowIn'} eq $desktop_name; if (defined $pool) { foreach my $category (split /;/, $entry->{'Categories'}) { $pool->{'Categories'}{$category} = [] unless defined $pool->{'Categories'}{$category}; push @{$pool->{'Categories'}{$category}}, $entry; } $pool->{'Desktop_entries'}{$entry->{'id'}} = $entry; } return $entry; } my $cached_pool; sub read_desktop_entries ($$) { my ($directory_paths, $desktop_paths) = @_; if ($cached_pool->{'Directory_paths'} eq $directory_paths && $cached_pool->{'Desktop_paths'} eq $desktop_paths) { return $cached_pool; } my $pool = {'Desktop_entries' => {}, 'Categories' => {}, 'Directory_entries' => {}, 'Directory_paths' => $directory_paths, 'Desktop_paths' => $desktop_paths }; foreach my $dir (split /:/, $directory_paths) { next if $dir =~ /^\s*$/; scan_DirectoryDir($pool, $dir); } foreach my $dir (split /:/, $desktop_paths) { next if $dir =~ /^\s*$/; scan_AppDir($pool, $dir); } $cached_pool = $pool; return $pool; } sub dump_entry_list ($) { my ($list) = @_; print "list: "; foreach my $entry (@$list) { print "$entry->{id} "; } print "\n"; } sub get_directory_entry ($$) { my ($entry, $pool) = @_; return $pool->{'Directory_entries'}{$entry}; } sub interpret_Include { my ($tree, $entries, $pool) = @_; my %exist; my $i = 0; my @list = interpret_entry_node($tree, 'Or', $pool); foreach my $e (@$entries) { if ($e->{type} eq 'desktop') { $exist{$e->{desktop}} = 1; } } # dump_entry_list(\@list); foreach my $entry (@list) { next if $exist{$entry}; push @$entries, {type => 'desktop', desktop => $entry}; $entry->{'refcount'}++; $exist{$entry} = 1; } } sub interpret_Exclude { my ($tree, $entries, $pool) = @_; my $i = 0; my @list = interpret_entry_node($tree, 'Or', $pool); foreach my $entry (@list) { my $i = 0; while (defined $entries->[$i]) { my $exist = $entries->[$i]; if ($exist->{type} eq 'desktop' && $exist->{desktop} eq $entry) { splice @$entries, $i, 1; $entry->{'refcount'}--; } else { $i++; } } } } sub interpret_entry_node ($$$) { my ($tree, $node, $pool) = @_; my $i = 0; $i++ if (ref($tree->[$i]) eq 'HASH'); my @subtree; while (defined $tree->[$i]) { if ($tree->[$i] eq 'Filename') { $i++; if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { my $entry = $tree->[$i][2]; if (defined $pool->{'Desktop_entries'}{$entry}) { push @subtree, [$pool->{'Desktop_entries'}{$entry}]; } else { push @subtree, []; } } else { print STDERR "Filename\n"; exit 1 if $die_on_error; } $i++; } elsif ($tree->[$i] eq 'Category') { $i++; if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { my $category = $tree->[$i][2]; if (defined $pool->{'Categories'}{$category}) { push @subtree, $pool->{'Categories'}{$category}; } else { push @subtree, []; } } else { print STDERR "Category\n"; exit 1 if $die_on_error; } $i++; } elsif ($tree->[$i] eq 'All') { $i++; if (values %{$pool->{'Desktop_entries'}} > 0) { push @subtree, [values %{$pool->{'Desktop_entries'}}]; } else { push @subtree, []; } $i++; } elsif ($tree->[$i] eq '0') { $i++; $i++; } else { my @res = interpret_entry_node($tree->[$i+1], $tree->[$i], $pool); push @subtree, \@res; $i++; $i++; } } if ($node eq 'Or') { # print "or - \n"; my %used; my @res; foreach my $st (@subtree) { # print " st: "; # dump_entry_list($st); foreach my $entry (@$st) { if (! defined $used{$entry}) { push @res, $entry; $used{$entry} = 1; } } } # print " res: "; # dump_entry_list(\@res); return @res; } elsif ($node eq 'And') { my %used; my @res; # print "and - \n"; my $cnt = @subtree; my $min = @{$subtree[0]}; my $min_idx = 0; my $idx = 0; foreach my $st (@subtree) { # print " st: "; # dump_entry_list($st); my $num = @$st; if ($num < $min) { $min = $num; $min_idx = $idx; } my %dupes; foreach my $entry (@$st) { next if $dupes{$entry}; $dupes{$entry} = 1; if (! defined $used{$entry}) { $used{$entry} = 1; } else { $used{$entry} ++ } } $idx ++; } return () if $cnt == 0; foreach my $entry (@{$subtree[$min_idx]}) { push @res, $entry if $used{$entry} == $cnt; } # print " res: "; # dump_entry_list(\@res); return @res; } elsif ($node eq 'Not') { my %used; my @res; # print "not - \n"; my $cnt = @subtree; foreach my $st (@subtree) { # print " st: "; # dump_entry_list($st); foreach my $entry (@$st) { $used{$entry} = 1; } } return if $cnt == 0; foreach my $entry (values %{$pool->{'Desktop_entries'}}) { push @res, $entry if !defined $used{$entry}; } # print " res: "; # dump_entry_list(\@res); return @res; } else { print STDERR "Can't use '$node' inside or \n"; exit 1 if $die_on_error; return (); } } sub interpret_root ($$) { my ($tree, $topdir) = @_; if ($tree->[0] eq 'Menu') { return interpret_menu($tree->[1]); } else { print STDERR "No toplevel Menu\n"; exit 1 if $die_on_error; return; } } sub interpret_menu ($;$$) { my ($tree, $directory_paths, $desktop_paths) = @_; $directory_paths = '' unless defined $directory_paths; $desktop_paths = '' unless defined $desktop_paths; my %menu = ('entries' => [], 'OnlyUnallocated' => 0, 'DontShowIfEmpty' => 0, 'Deleted' => 0); my $i = 0; $i++ if (ref($tree->[$i]) eq 'HASH'); while (defined $tree->[$i]) { if ($tree->[$i] eq 'AppDir') { if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') { $desktop_paths .= ':' . $tree->[$i + 1][2]; splice @$tree, $i, 2; } else { print STDERR "wrong AppDir\n"; exit 1 if $die_on_error; $i++; $i++; } } elsif ($tree->[$i] eq 'DefaultAppDirs') { $desktop_paths .= ':' . $DefaultAppDirs; splice @$tree, $i, 2; } elsif ($tree->[$i] eq 'DirectoryDir') { if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') { $directory_paths .= ':' . $tree->[$i + 1][2]; splice @$tree, $i, 2; } else { print STDERR "wrong DirectoryDir\n"; exit 1 if $die_on_error; $i++; $i++; } } elsif ($tree->[$i] eq 'DefaultDirectoryDirs') { $directory_paths .= ':' . $DefaultDirectoryDirs; splice @$tree, $i, 2; } else { $i++; $i++; } } $menu{directory_paths} = $directory_paths; $menu{desktop_paths} = $desktop_paths; my $pool = read_desktop_entries($directory_paths, $desktop_paths); $i = 0; $i++ if (ref($tree->[$i]) eq 'HASH'); while (defined $tree->[$i]) { if ($tree->[$i] eq 'Menu') { $i++; my $submenu = interpret_menu($tree->[$i], $directory_paths, $desktop_paths); push @{$menu{'entries'}}, {type => 'menu', menu => $submenu}; $i++; } elsif ($tree->[$i] eq 'Name') { $i++; if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { $menu{'Name'} = $tree->[$i][2]; } else { print STDERR "wrong Name\n"; exit 1 if $die_on_error; } $i++; } elsif ($tree->[$i] eq 'Directory') { $i++; if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { $menu{'Directory'} = get_directory_entry($tree->[$i][2], $pool); # print "Directory " . $tree->[$i][2] . "\n"; } else { print STDERR "wrong Directory\n"; exit 1 if $die_on_error; } $i++; } elsif ($tree->[$i] eq 'OnlyUnallocated') { $menu{'OnlyUnallocated'} = 1; $i++; $i++; } elsif ($tree->[$i] eq 'DontShowIfEmpty') { $menu{'DontShowIfEmpty'} = 1; $i++; $i++; } elsif ($tree->[$i] eq 'Deleted') { $menu{'Deleted'} = 1; $i++; $i++; } elsif ($tree->[$i] eq 'NotDeleted') { $menu{'Deleted'} = 0; $i++; $i++; } elsif ($tree->[$i] eq 'Include') { $i++; interpret_Include($tree->[$i], $menu{'entries'}, $pool); $i++; } elsif ($tree->[$i] eq 'Exclude') { $i++; interpret_Exclude($tree->[$i], $menu{'entries'}, $pool); $i++; } elsif ($tree->[$i] eq '0') { $i++; if ($tree->[$i] !~ /^\s*$/) { print STDERR "skip '$tree->[$i]'\n" ; exit 1 if $die_on_error; } $i++; } else { print STDERR "Unknown '$tree->[$i]':\n"; $i++; print STDERR " '@{$tree->[$i]}'\n"; $i++; exit 1 if $die_on_error; } } return \%menu; } sub read_menu ($;$) { my ($file, $basedir) = @_; if ($file !~ /^\// && defined $basedir) { $file = "$basedir/$file"; } unless (defined $basedir) { $basedir = $file; $basedir =~ s/\/[^\/]*$//; } unless (check_file($file)) { print STDERR "WARNING: '$file' does not exist\n"; return ['Menu', [{}]]; } print STDERR "reading '$file'\n" if $verbose; my $parser = new XML::Parser(Style => 'Tree'); my $tree = $parser->parsefile($file); my $DefaultMergeDir = $file; $DefaultMergeDir =~ s/^.*\///; $DefaultMergeDir =~ s/\.menu$/-merged/; read_includes($tree, $basedir, $DefaultMergeDir); return $tree } sub read_menu_dir ($;$) { my ($dir, $basedir) = @_; my @out; if ($dir !~ /^\// && defined $basedir) { $dir = "$basedir/$dir"; } check_file($dir); opendir(DIR, $dir); foreach my $entry (readdir(DIR)) { if ( -f "$dir/$entry" && $entry =~ /\.menu$/ ) { my $menu = read_menu("$dir/$entry"); $menu = remove_toplevel_Menu($menu); push @out, @$menu; } } closedir DIR; return \@out; } sub quote_xml ($) { my ($txt) = @_; $txt =~ s/&/&/g; $txt =~ s//>/g; return $txt; } sub read_legacy_dir ($;$) { my ($dir,$basedir) = @_; my $out; $dir =~ s/\/*$//; $basedir = $dir unless defined $basedir; return "" if check_file($dir) ne 'D'; $out = "\n"; if ($dir eq $basedir) { my $xmldir = quote_xml($dir); $out .= "$xmldir\n"; $out .= "$xmldir\n"; } else { my $name = $dir; $name =~ s/\/*$//; $name =~ s/^.*\///; $name = quote_xml($name); $out .= "$name\n"; } if (-f "$dir/.directory") { my $dir_id = "$dir/.directory"; $dir_id =~ s/^$basedir//; $dir_id =~ s/^\///; $dir_id = quote_xml($dir_id); $out .= "$dir_id\n"; } opendir(DIR, $dir); foreach my $entry (readdir(DIR)) { if ( -f "$dir/$entry" && $entry =~ /\.desktop$/ ) { my $id = "$dir/$entry"; $id =~ s/^$basedir//; $id =~ s/^\///; $id =~ s/\//-/g; $id = quote_xml($id); my $desktop = read_desktop_entry(undef, "$dir/$entry", $basedir); $out .= "$id\n" unless defined $desktop->{'Categories'} } elsif ( -d "$dir/$entry" && $entry ne '.' && $entry ne '..' && $entry ne '.hidden') { $out .= read_legacy_dir("$dir/$entry", $basedir); } } closedir DIR; $out .= "\n"; return $out; } sub remove_toplevel_Menu ($) { my ($tree) = @_; if ($tree->[0] eq 'Menu') { shift @{$tree->[1]} if (ref($tree->[1][0]) eq 'HASH'); return $tree->[1]; } else { print STDERR "No toplevel Menu\n"; exit 1 if $die_on_error; return; } } sub read_includes ($$$) { my ($tree, $basedir, $DefaultMergeDir) = @_; my $i = 0; $i++ if (ref($tree->[$i]) eq 'HASH'); while (defined $tree->[$i]) { if ($tree->[$i] eq 'MergeFile') { if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') { my $add_tree = read_menu($tree->[$i + 1][2], $basedir); $add_tree = remove_toplevel_Menu($add_tree); splice @$tree, $i, 2, @$add_tree; } else { print STDERR "wrong MergeFile\n"; exit 1 if $die_on_error; $i++; $i++; } } elsif ($tree->[$i] eq 'MergeDir') { if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') { my $add_tree = read_menu_dir($tree->[$i + 1][2], $basedir); splice @$tree, $i, 2, @$add_tree; } else { print STDERR "wrong MergeFile\n"; exit 1 if $die_on_error; $i++; $i++; } } elsif ($tree->[$i] eq 'DefaultMergeDirs') { my $add_tree = read_menu_dir($DefaultMergeDir, $basedir); splice @$tree, $i, 2, @$add_tree; } elsif ($tree->[$i] eq 'LegacyDir') { if (ref($tree->[$i + 1][0]) eq 'HASH' and $tree->[$i + 1][1] eq '0') { my $xml = read_legacy_dir($tree->[$i + 1][2]); print STDERR "reading legacy directory '" . $tree->[$i + 1][2] . "'\n" if $verbose; my $parser = new XML::Parser(Style => 'Tree'); my $add_tree = $parser->parse($xml); $add_tree = remove_toplevel_Menu($add_tree); splice @$tree, $i, 2, @$add_tree; } else { print STDERR "wrong LegacyDir\n"; exit 1 if $die_on_error; $i++; $i++; } } elsif ($tree->[$i] eq 'KDELegacyDirs') { my @out; foreach my $dir (@KDELegacyDirs) { my $xml = read_legacy_dir($dir); print STDERR "reading legacy directory '$dir'\n" if $verbose; my $parser = new XML::Parser(Style => 'Tree'); my $add_tree = $parser->parse($xml); $add_tree = remove_toplevel_Menu($add_tree); push @out, @$add_tree } splice @$tree, $i, 2, @out; } elsif ($tree->[$i] eq 'Menu') { $i++; read_includes($tree->[$i], $basedir, $DefaultMergeDir); $i++; } else { $i++; $i++; } } } sub get_menu_name ($) { my ($tree) = @_; my $name; my $i = 0; $i++ if (ref($tree->[$i]) eq 'HASH'); while (defined $tree->[$i]) { if ($tree->[$i] eq 'Name') { $i++; if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { $name = $tree->[$i][2]; last; } else { print STDERR "wrong Name\n"; } $i++; } else { $i++; $i++; } } unless (defined $name) { print STDERR "Menu has no name element\n"; } return $name; } sub append_menu ($$) { my ($target, $source) = @_; my $i = 0; $i++ if (ref($source->[$i]) eq 'HASH'); while (defined $source->[$i]) { if ($source->[$i] ne 'Name') { push @$target, $source->[$i]; push @$target, $source->[$i + 1]; } $i++; $i++; } } sub merge_menus ($) { my ($tree) = @_; my %used; #menu name already used my $i = 0; $i++ if (ref($tree->[$i]) eq 'HASH'); while (defined $tree->[$i]) { if ($tree->[$i] eq 'Menu') { my $name = get_menu_name($tree->[$i + 1]); if (defined $used{$name}) { #second menu with the same name my $target = $used{$name}; append_menu($tree->[$target], $tree->[$i + 1]); splice @$tree, $i, 2; } else { # first appearance $used{$name} = $i + 1; $i++; $i++; } } else { $i++; $i++; } } $i = 0; $i++ if (ref($tree->[$i]) eq 'HASH'); while (defined $tree->[$i]) { if ($tree->[$i] eq 'Menu') { merge_menus($tree->[$i + 1]); } $i++; $i++; } } sub read_Move ($$) { my ($tree, $hash) = @_; my $i = 0; my $old = ''; $i++ if (ref($tree->[$i]) eq 'HASH'); while (defined $tree->[$i]) { if ($tree->[$i] eq 'Old') { $i++; if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { $old = $tree->[$i][2]; } else { print STDERR "wrong Old\n"; exit 1 if $die_on_error; } $i++; } if ($tree->[$i] eq 'New') { $i++; if (ref($tree->[$i][0]) eq 'HASH' and $tree->[$i][1] eq '0') { $hash->{$old} = $tree->[$i][2]; } else { print STDERR "wrong New\n"; exit 1 if $die_on_error; } $i++; } else { $i++; $i++; } } } sub find_menu_in_tree ($$) { my ($path, $tree) = @_; my $root = $path; $root =~ s/\/.*$//; my $subpath = $path; $subpath =~ s/^[^\/]*\/*//; my $i = 0; $i++ if (ref($tree->[$i]) eq 'HASH'); while (defined $tree->[$i]) { if ($tree->[$i] eq 'Menu') { if ($root eq get_menu_name($tree->[$i + 1])) { if ($subpath eq '') { return { 'parent' => $tree, 'index' => $i, 'menu' => $tree->[$i + 1]}; } return find_menu_in_tree($subpath, $tree->[$i + 1]); } } $i++; $i++; } return undef; } sub copy_menu ($$) { my ($path, $tree) = @_; my $tail; my $child; foreach my $elem (reverse split(/\//, $path)) { next if $elem eq ''; my $menu = [{}, 'Name', [{}, 0, $elem]]; push @$menu, ('Menu', $child) if defined $child; $tail = $menu unless defined $tail; $child = $menu; } append_menu($tail, $tree); return $child; } sub move_menus ($) { my ($tree) = @_; # print "@$tree\n"; my %move; my $i = 0; $i++ if (ref($tree->[$i]) eq 'HASH'); while (defined $tree->[$i]) { if ($tree->[$i] eq 'Move') { read_Move($tree->[$i + 1], \%move); splice @$tree, $i, 2; } else { $i++; $i++; } } foreach my $source (keys %move) { my $sourceinfo = find_menu_in_tree($source, $tree); if (defined $sourceinfo) { my $target = copy_menu($move{$source}, $sourceinfo->{'menu'}); splice @{$sourceinfo->{'parent'}}, $sourceinfo->{'index'}, 2; push @$tree, ('Menu', $target); merge_menus($tree); } } $i = 0; $i++ if (ref($tree->[$i]) eq 'HASH'); while (defined $tree->[$i]) { if ($tree->[$i] eq 'Menu') { move_menus($tree->[$i + 1]); } $i++; $i++; } } sub remove_allocated ($) { my ($menu) = @_; my $i = 0; while ($i < @{$menu->{'entries'}}) { my $entry = $menu->{'entries'}[$i]; if ($entry->{type} eq 'menu') { remove_allocated($entry->{menu}); $i++; } elsif ($entry->{type} eq 'desktop' && $menu->{'OnlyUnallocated'} && $entry->{desktop}{'refcount'} > 1) { $entry->{desktop}{'refcount'}--; splice @{$menu->{'entries'}}, $i, 1; } else { $i++; } } return 0; } sub remove_empty_menus ($) { my ($menu) = @_; my $i = 0; while ($i < @{$menu->{'entries'}}) { my $entry = $menu->{'entries'}[$i]; if ($entry->{type} eq 'menu' && remove_empty_menus($entry->{menu})) { splice @{$menu->{'entries'}}, $i, 1; } else { $i++; } } return 1 if @{$menu->{'entries'}} == 0; # && $menu->{'DontShowIfEmpty'}; #menu is empty return 0; } sub prepare_exec ($$) { my ($exec, $desktop) = @_; $exec =~ s/%f//g; $exec =~ s/%F//g; $exec =~ s/%u//g; $exec =~ s/%U//g; $exec =~ s/%d//g; $exec =~ s/%D//g; $exec =~ s/%n//g; $exec =~ s/%N//g; $exec =~ s/%i//g; $exec =~ s/%k//g; $exec =~ s/%v//g; $exec =~ s/%m//g; my $caption = $desktop->{Name}; $exec =~ s/%c/$caption/g; $exec =~ s/%%/%/g; $exec = "xterm -e $exec" if $desktop->{Terminal} eq '1' || $desktop->{Terminal} eq 'true'; $exec = "$root_cmd $exec" if $desktop->{'X-KDE-SubstituteUID'} eq '1' || $desktop->{'X-KDE-SubstituteUID'} eq 'true'; return $exec; } sub get_loc_entry ($$) { my ($desktop, $entry) = @_; foreach my $key (@language_keys) { my $loc_entry = $entry . "[$key]"; return $desktop->{$loc_entry} if defined $desktop->{$loc_entry} && $desktop->{$loc_entry} !~ /^\s*$/; } return $desktop->{$entry}; } sub preprocess_menu ($) { # localize, sort, prepare_exec my ($menu) = @_; return 0 if $menu->{'Deleted'}; return 0 unless check_show_in($menu->{'Directory'}); return 0 if defined $menu->{'Directory'} && $menu->{'Directory'}->{'NoDisplay'} eq 'true'; my $menu_name = $menu->{'Name'}; my $menu_icon = ""; if (defined $menu->{'Directory'}) { my $directory = $menu->{'Directory'}; $menu_icon = $menu->{'Directory'}{'Icon'}; my $directory_name = get_loc_entry($directory, 'Name'); if (defined $directory_name) { Encode::from_to($directory_name, "utf8", $charset) if !defined $directory->{"Encoding"} || $directory->{"Encoding"} eq 'UTF-8'; $menu_name = $directory_name; } } $menu->{'PrepName'} = $menu_name; $menu->{'PrepIcon'} = $menu_icon; my $i = 0; while (defined $menu->{'entries'}[$i]) { my $entry = $menu->{'entries'}[$i]; if ($entry->{'type'} eq 'desktop') { my $desktop = $entry->{desktop}; my $name = $desktop->{'id'}; my $desktop_name = get_loc_entry($desktop, 'Name'); if (defined $desktop_name) { Encode::from_to($desktop_name, "utf8", $charset) if !defined $desktop->{"Encoding"} || $desktop->{"Encoding"} eq 'UTF-8'; $name = $desktop_name; } $desktop->{'PrepName'} = $name; $entry->{'Name'} = $name; $entry->{'PrepName'} = $name; $desktop->{'PrepExec'} = prepare_exec($desktop->{Exec}, $desktop); $i++; } elsif ($entry->{type} eq 'menu') { if (preprocess_menu ($entry->{'menu'})) { $entry->{'Name'} = $entry->{'menu'}{'Name'}; $entry->{'PrepName'} = $entry->{'menu'}{'PrepName'}; $i++; } else { splice @{$menu->{'entries'}}, $i, 1; } } else { print STDERR "wrong menu entry type: $entry->{type}"; exit 1 if $die_on_error; splice @{$menu->{'entries'}}, $i, 1; } } $menu->{'entries'} = [ sort {$b->{'type'} cmp $a->{'type'} || $a->{'PrepName'} cmp $b->{'PrepName'}} @{$menu->{'entries'}} ]; my $i = 0; my $prev_entry; while (defined $menu->{'entries'}[$i]) { my $entry = $menu->{'entries'}[$i]; if (defined $prev_entry && $entry->{'type'} eq 'desktop' && $prev_entry->{'type'} eq 'desktop' && $prev_entry->{'PrepName'} eq $entry->{'PrepName'} && $prev_entry->{'desktop'}->{'PrepExec'} eq $entry->{'desktop'}->{'PrepExec'}) { splice @{$menu->{'entries'}}, $i, 1; } else { $prev_entry = $entry; $i++; } } return 1; } sub output_twm_menu ($;$$) { my ($menu, $toplevel, $path) = @_; my $output = ''; $path = '' unless defined $path; $toplevel = 1 unless defined $toplevel; my $menu_name = $menu->{'PrepName'}; my $menu_id = "$path-" . $menu->{'Name'}; $menu_id =~ s/\s/_/g; $menu_id = 'xdg_menu' if $toplevel; foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'menu') { $output .= output_twm_menu($entry->{'menu'}, 0, $menu_id); } } $output .= "menu \"$menu_id\" {\n"; $output .= "\"$menu_name\" f.title\n"; foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'desktop') { my $desktop = $entry->{desktop}; my $name = $desktop->{'PrepName'}; my $exec = $desktop->{'PrepExec'}; my $color = ''; $exec =~ s/"/\\"/g; $color = ' ("red":"grey")' if $desktop->{'X-KDE-SubstituteUID'} eq '1' || $desktop->{'X-KDE-SubstituteUID'} eq 'true'; $output .= "\"$name\"$color f.exec \"$exec&\"\n"; } elsif ($entry->{type} eq 'menu') { my $name = $entry->{'menu'}{'PrepName'}; my $id = "$menu_id-" . $entry->{'menu'}{'Name'}; $id =~ s/\s/_/g; $output .= "\"$name\" f.menu \"$id\"\n"; } else { print STDERR "wrong menu entry type: $entry->{type}"; } } $output .= "}\n"; return $output; } sub output_wmaker_menu ($;$) { my ($menu, $indent) = @_; my $output = ''; $indent = 0 unless defined $indent; my $menu_name = $menu->{'PrepName'}; $output .= ' ' x $indent; $output .= "\"$menu_name\" MENU\n"; if ($indent == 0) { $output .= "\n#include \"user.menu\"\n\n"; } foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'desktop') { my $desktop = $entry->{desktop}; my $name = $desktop->{'PrepName'}; my $exec = $desktop->{'PrepExec'}; $output .= ' ' x $indent; $output .= " \"$name\" EXEC $exec\n"; } elsif ($entry->{type} eq 'menu') { $output .= output_wmaker_menu ($entry->{'menu'}, $indent + 1); } else { print STDERR "wrong menu entry type: $entry->{type}"; } } if ($indent == 0) { textdomain("menu-messages"); my $exit_msg = gettext("Exit"); my $restart_msg = gettext("Restart"); if (langinfo(CODESET) ne 'UTF-8') { $exit_msg = Encode::encode_utf8($exit_msg); $restart_msg = Encode::encode_utf8($restart_msg); } $output .= "\t\"$exit_msg\" MENU\n\t\t\"$restart_msg\" RESTART\n\t\t\"$exit_msg\" EXIT\n\"$exit_msg\" END\n"; } $output .= ' ' x $indent; $output .= "\"$menu_name\" END\n"; return $output; } sub output_fvwm2_menu ($;$$) { my ($menu, $toplevel, $path) = @_; my $output = ''; $path = '' unless defined $path; $toplevel = 1 unless defined $toplevel; my $menu_name = $menu->{'PrepName'}; my $menu_id = "$path-" . $menu->{'Name'}; $menu_id =~ s/\s/_/g; $menu_id = 'xdg_menu' if $toplevel; foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'menu') { $output .= output_fvwm2_menu($entry->{'menu'}, 0, $menu_id); } } $output .= "DestroyMenu \"$menu_id\"\n"; $output .= "AddToMenu \"$menu_id\" \"$menu_name\" Title\n"; foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'desktop') { my $desktop = $entry->{desktop}; my $name = $desktop->{'PrepName'}; my $exec = $desktop->{'PrepExec'}; $output .= "+ \"$name\" Exec $exec\n"; } elsif ($entry->{type} eq 'menu') { my $name = $entry->{'menu'}{'PrepName'}; my $id = "$menu_id-" . $entry->{'menu'}{'Name'}; $id =~ s/\s/_/g; $output .= "+ \"$name\" Popup \"$id\"\n"; } else { print STDERR "wrong menu entry type: $entry->{type}"; } } $output .= "\n"; return $output; } sub output_blackbox_menu ($;$) { my ($menu, $indent) = @_; my $output = ''; my $run = $format eq 'fluxbox' ? 'fbrun -nearmouse' : 'bbrun -a -w'; $output .= "[begin] (Menu)\n"; $output .= output_blackbox_inner_menu ($menu, $indent); $output .= "[separator]\n"; $output .= '[config] (Configuration) [workspaces] (Workspace) [submenu] (System Styles) {Choose a style...} [stylesdir] (/usr/share/blackbox/styles) [stylesdir] (/usr/share/fluxbox/styles) [stylesdir] (/usr/share/openbox/styles) [end] [submenu] (User Styles) {Choose a style...} [stylesdir] (~/.blackbox/styles) [stylesdir] (~/.fluxbox/styles) [stylesdir] (~/.openbox/styles) [end] [separator] [exec] (Run Command) {' . $run . '} [exec] (Lock Screen) {xlock} [restart] (Restart) {} [exit] (Logout) [end] '; $output .= "[end]\n"; return $output; } sub output_blackbox_inner_menu ($;$) { my ($menu, $indent) = @_; my $output = ''; $indent = 0 unless defined $indent; my $menu_name = $menu->{'PrepName'}; $output .= ' ' x $indent; $output .= "[submenu] ($menu_name)\n"; foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'desktop') { my $desktop = $entry->{desktop}; my $name = $desktop->{'PrepName'}; my $exec = $desktop->{'PrepExec'}; $output .= ' ' x $indent; $output .= " [exec] ($name) {$exec}\n"; } elsif ($entry->{type} eq 'menu') { $output .= output_blackbox_inner_menu ($entry->{'menu'}, $indent + 1); } else { print STDERR "wrong menu entry type: $entry->{type}"; } } $output .= ' ' x $indent; $output .= "[end] # ($menu_name)\n"; return $output; } sub output_icewm_menu ($;$) { my ($menu, $indent) = @_; my $output = ''; $indent = 0 unless defined $indent; my $menu_name = $menu->{'PrepName'}; my $menu_icon = $menu->{'PrepIcon'} || "folder" ; $output .= ' ' x $indent; $output .= "menu \"$menu_name\" $menu_icon.png {\n"; foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'desktop') { my $desktop = $entry->{desktop}; my $name = $desktop->{'PrepName'}; my $exec = $desktop->{'PrepExec'}; my $icon = add_png_extension_if_needed($desktop->{'Icon'}); $output .= ' ' x $indent; $output .= " prog \"$name\" $icon $exec\n"; } elsif ($entry->{type} eq 'menu') { $output .= output_icewm_menu ($entry->{'menu'}, $indent + 1); } else { print STDERR "wrong menu entry type: $entry->{type}"; } } $output .= ' ' x $indent; $output .= "}\n"; return $output; } sub prepare_exec_xfce4 ($$) { my ($exec, $desktop) = @_; $exec =~ s/%f//g; $exec =~ s/%F//g; $exec =~ s/%u//g; $exec =~ s/%U//g; $exec =~ s/%d//g; $exec =~ s/%D//g; $exec =~ s/%n//g; $exec =~ s/%N//g; $exec =~ s/%i//g; $exec =~ s/%k//g; $exec =~ s/%v//g; $exec =~ s/%m//g; my $caption = $desktop->{Name}; $exec =~ s/%c/$caption/g; $exec =~ s/%%/%/g; $exec =~ s/\"/"/g; $exec = "$root_cmd $exec" if $desktop->{'X-KDE-SubstituteUID'} eq '1' || $desktop->{'X-KDE-SubstituteUID'} eq 'true'; return $exec; } sub output_xfce4_menu ($;$) { my ($menu, $indent) = @_; my $output = ''; $indent = 0 unless defined $indent; if ($indent == 0) { $output .= '' . "\n"; $output .= '' . "\n"; $output .= ']>' . "\n\n"; } my $menu_name = $menu->{'PrepName'}; my $menu_ico = $menu->{'PrepIcon'}; $output .= ' ' x $indent; if ($indent == 0) { $output .= "\n" } else { $output .= "\n"; } foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'desktop') { my $desktop = $entry->{desktop}; my $name = $desktop->{'PrepName'}; my $exec = prepare_exec_xfce4($desktop->{Exec}, $desktop); my $term = ($desktop->{Terminal} eq '1' || $desktop->{Terminal} eq 'true') ? "yes" : "no"; my $ico = $desktop->{'Icon'}; $output .= ' ' x $indent; $output .= " \n"; } elsif ($entry->{type} eq 'menu') { $output .= output_xfce4_menu ($entry->{'menu'}, $indent + 1); } else { print STDERR "wrong menu entry type: $entry->{type}"; } } $output .= ' ' x $indent; if ($indent == 0) { $output .= "\n"; } else { $output .= "\n"; } return $output; } sub output_openbox3_menu ($;$) { my ($menu, $indent) = @_; my $output = ''; $output .= ' '; $output .= "\n"; $output .= output_openbox3_inner_menu ($menu, $indent); $output .= "\n"; $output .= ' xterm obconf xlock -remote -nice 19 -mode blank -geometry 1x1 -enablesaver '; $output .= "\n"; return $output; } sub output_openbox3_pipe_menu ($;$) { my ($menu, $indent) = @_; my $output = ''; $output .= "\n"; $output .= output_openbox3_inner_menu ($menu, $indent); $output .= "\n"; return $output; } sub output_openbox3_inner_menu ($;$) { my ($menu, $indent) = @_; my $output = ''; $indent = 0 unless defined $indent; my $menu_name = $menu->{'PrepName'}; $output .= ' ' x $indent; $output .= "\n"; # $output .= "\n"; foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'desktop') { my $desktop = $entry->{desktop}; my $name = $desktop->{'PrepName'}; my $exec = $desktop->{'PrepExec'}; $output .= ' ' x $indent; $output .= " \n"; $output .= " $exec\n"; $output .= " \n"; } elsif ($entry->{type} eq 'menu') { $output .= output_openbox3_inner_menu ($entry->{'menu'}, $indent + 1); } else { print STDERR "wrong menu entry type: $entry->{type}"; } } $output .= ' ' x $indent; $output .= " \n"; return $output; } sub output_readable ($;$) { my ($menu, $indent) = @_; my $output = ''; $indent = 0 unless defined $indent; my $menu_name = $menu->{'Name'}; $output .= "\t" x $indent; $output .= "\"$menu_name\" MENU\n"; foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'desktop') { my $desktop = $entry->{desktop}; my $name = $desktop->{Name}; $output .= "\t" x $indent; $output .= "\t\"$name\"\n"; my @v = %$desktop; $output .= "@v\n" if $name eq ''; } elsif ($entry->{type} eq 'menu') { $output .= output_readable ($entry->{menu}, $indent + 1); } else { print STDERR "wrong menu entry type: $entry->{type}"; } } return $output; } sub get_root_menu { foreach my $dir (split(/:/, $ENV{XDG_CONFIG_DIRS}), "/etc/xdg") { check_file("$dir/menus/applications.menu"); return "$dir/menus/applications.menu" if -f "$dir/menus/applications.menu"; } return ""; } sub get_app_dirs { my %used; my $ret = ''; my @kde_xdgdata = split(/:/, `kde-config --path xdgdata-apps`); foreach $_ (@kde_xdgdata) { s/\/applications\/*\s*$//; }; foreach my $d (split(/:/, $ENV{XDG_DATA_DIRS}), @kde_xdgdata, "/usr/share", "/opt/gnome/share") { my $dir = $d; $dir =~ s/\/*$//; next if defined $used{$dir}; next if check_file("$dir/applications") ne 'D'; $ret .= ':' if $ret ne ''; $ret .= "$dir/applications"; $used{$dir} = 1; } return $ret; } sub get_desktop_dirs { my %used; my $ret = ''; foreach my $dir (split(/:/, $ENV{XDG_DATA_DIRS}), "/usr/share", "/opt/kde3/share", "/opt/gnome/share") { next if defined $used{$dir}; next if check_file("$dir/desktop-directories") ne 'D'; $ret .= ':' if $ret ne ''; $ret .= "$dir/desktop-directories"; $used{$dir} = 1; } return $ret; } sub get_KDE_legacy_dirs { my %used; my @ret; foreach my $d ("/etc/opt/kde3/share/applnk", "/opt/kde3/share/applnk", reverse(split(/:/, `kde-config --path apps`))) { my $dir = $d; chomp $dir; $dir =~ s/\/*$//; next if defined $used{$dir}; next if check_file("$dir") ne 'D'; $used{$dir} = 1; push @ret, $dir; } return @ret; } sub prepare_language_keys ($) { my ($language) = @_; my @keys; $language =~ s/\.[^@]*//; # remove .ENCODING if ($language =~ /^([^_]*)_([^@]*)@(.*)$/) { # LANG_COUNTRY@MODIFIER push @keys, $1 . '_' . $2 . '@' . $3; push @keys, $1 . '_' . $2; push @keys, $1 . '@' . $3; push @keys, $1; } elsif ($language =~ /^([^_]*)_([^@]*)$/) { # LANG_COUNTRY push @keys, $1 . '_' . $2; push @keys, $1; } elsif ($language =~ /^([^_]*)@(.*)$/) { # LANG@MODIFIER push @keys, $1 . '@' . $2; push @keys, $1; } elsif ($language =~ /^([^_@]*)$/) { # LANG push @keys, $1; } return @keys; } sub check_cache { my $cachedir = $ENV{HOME}; return unless -d $cachedir; $cachedir .= "/.xdg_menu_cache"; return unless -f "$cachedir/inputs" && -f "$cachedir/output"; my @st = stat "$cachedir/output"; my $ref_time = $st[10]; #ctime open(FILE, "<$cachedir/inputs"); my $num_opts = 0; while () { chomp; next if /^\s*$/; next if /^#/; if (/^[FD] (.*)$/) { my $file = $1; my @st = stat $file; my $time = $st[10]; #ctime if (!defined $time || $time >= $ref_time) { # print STDERR "$file: is newer\n"; return; } } elsif (/^X (.*)$/) { my $file = $1; if (-e $file) { # print STDERR "$file: exists\n"; return; } } elsif (/^ENV ([^ ]+) (.*)$/) { my $var = $1; my $val = $2; if ($ENV{$var} ne $val) { # print STDERR "$var: differs\n"; return; } } elsif (/^OPT ([0-9]+) (.*)$/) { my $optidx = $1; my $val = $2; $num_opts ++; if ($save_ARGV[$optidx] ne $val) { # print STDERR "$optidx: differs\n"; return; } } elsif (/^CHARSET (.*)$/) { my $charset = $1; if ($charset ne langinfo(CODESET)) { # print STDERR "charset $charset differs\n"; return; } } elsif (/^LANGUAGE (.*)$/) { my $language = $1; if ($language ne setlocale(LC_MESSAGES)) { # print STDERR "language $language differs\n"; return; } } elsif (/^VERSION (.*)$/) { my $v = $1; if ($v ne $Version) { # print STDERR "Version differs\n"; return; } } else { print STDERR "Wrong cache inputs list\n"; return; } } return if $num_opts != @save_ARGV; open(FILE, "<$cachedir/output") or return; print STDERR "Using cached output\n" if $verbose; my $buf; while(read(FILE, $buf, 4096)) { print $buf; } close(FILE); exit 0; } sub write_cache ($) { my ($output) = @_; my $cachedir = $ENV{HOME}; return unless -d $cachedir; $cachedir .= "/.xdg_menu_cache"; mkdir $cachedir; unlink "$cachedir/output"; open(FILE, ">$cachedir/inputs") or return; print FILE "# this file contains list of inputs xdg_menu\n"; print FILE "VERSION $Version\n"; print FILE "\n\n"; print FILE join("\n", @accessed_files); print FILE "\n\n"; for (my $i = 0; $i < @save_ARGV; $i++) { print FILE "OPT $i $save_ARGV[$i]\n"; } print FILE "ENV XDG_CONFIG_DIRS $ENV{XDG_CONFIG_DIRS}\n"; print FILE "ENV XDG_DATA_DIRS $ENV{XDG_DATA_DIRS}\n"; print FILE "CHARSET " . langinfo(CODESET) . "\n"; print FILE "LANGUAGE " . setlocale(LC_MESSAGES) . "\n"; close(FILE); open(FILE, ">$cachedir/output") or return; print FILE $output; close(FILE); } check_cache(); use XML::Parser; $DefaultAppDirs = get_app_dirs(); $DefaultDirectoryDirs = get_desktop_dirs(); my $root_menu = get_root_menu(); @KDELegacyDirs = get_KDE_legacy_dirs(); $charset = langinfo(CODESET); $language = setlocale(LC_MESSAGES); $root_cmd = "/opt/gnome/bin/gnomesu" if -x '/opt/gnome/bin/gnomesu'; $root_cmd = "/opt/kde3/bin/kdesu" if -x '/opt/kde3/bin/kdesu'; my $help; GetOptions("format=s" => \$format, "fullmenu" => \$fullmenu, "desktop=s" => \$desktop_name, "charset=s" => \$charset, "language=s" => \$language, "root-menu=s" => \$root_menu, "die-on-error" => \$die_on_error, "verbose" => \$verbose, "help" => \$help ); @language_keys = prepare_language_keys($language); $desktop_name = $format unless defined $desktop_name; if ($help) { print <<"EOF"; xdg-menu - XDG menus for WindowMaker and other window managers http://freedesktop.org/Standards/menu-spec Usage: xdg_menu [--format ] [--desktop ] [--charset ] [--language ] [--root-menu ] [--die-on-error] [--fullmenu] [--help] format - output format possible formats: WindowMaker, fvwm2, icewm, blackbox, fluxbox, openbox, xfce4, openbox3, openbox3-pipe, mwm, readable default: WindowMaker fullmenu - output a full menu and not only a submenu desktop - desktop name for NotShowIn and OnlyShowIn default: the same as format charset - output charset default: $charset language - output language default: $language root-menu - location of root menu file default: $root_menu die-on-error - abort execution on any error, default: try to continue verbose - print debugging information help - print this text EOF exit 0; } unless ( -f $root_menu) { print STDERR "Can't find root menu file.\n"; exit 1; } my $tree = read_menu($root_menu); merge_menus($tree); move_menus($tree); my $menu = interpret_root($tree, ''); remove_allocated($menu); preprocess_menu($menu); remove_empty_menus($menu); my $output; if ($format eq 'WindowMaker') { $output = output_wmaker_menu($menu) } elsif ($format eq 'fvwm2') { $output = output_fvwm2_menu($menu) } elsif ($format eq 'icewm') { foreach my $entry (@{$menu->{'entries'}}) { if ($entry->{type} eq 'menu') { $output .= output_icewm_menu ($entry->{'menu'}); } } } elsif ($format eq 'xfce4') { $output = output_xfce4_menu($menu) } elsif ($format eq 'blackbox' || ($format eq 'openbox') || ($format eq 'fluxbox') ) { if ($fullmenu) { $output = output_blackbox_menu($menu) } else { $output = output_blackbox_inner_menu($menu) } } elsif ($format eq 'openbox3') { if ($fullmenu) { $output = output_openbox3_menu($menu) } else { $output = output_openbox3_inner_menu($menu) } } elsif ($format eq 'openbox3-pipe') { $output = output_openbox3_pipe_menu($menu) } elsif ($format eq 'twm') { print STDERR "WARNING: twm does not support umlauts. Parameter --language '' to output plain ASCII.\n" unless $language eq ''; $output = output_twm_menu($menu) } elsif ($format eq 'mwm') { $output = output_twm_menu($menu) } elsif ($format eq 'readable') { $output = output_readable($menu) } else { print STDERR "Unknown format $format\n"; exit 1; } print $output; write_cache($output); exit 0;