ObPacView: a generally useless installed-package viewer for Openbox

Xyne · 2009-10-09 20:19:19

This is another great example of why I need to stop listening to that little voice in my head that wonders how to code this or that. This is probably not very useful in its present state but someone might be able to turn it into something more interesting (maybe I will at a later date... if I do, I'll package it etc).

What it does:
It creates an Openbox pipe menu which contains a list of all installed packages. Each item connects to a menu which shows package information from the output of "pacman -Qi". Dependencies (both upstream and downstream) are shown as nested menus.

You can pass it command line arguments to select which fields it displays, e.g. "obpacview Description 'Depends On' 'Required By'". It defaults to all of the fields otherwise.

I mostly wrote this because I wanted to test Openbox's use of menu IDs to re-insert menus. If you look at the code, you'll see that there's an algorithm to recursively nest menus and keep track of which ones have already been used. This makes it possible to handle any level of nesting, including cyclical, with only a finite set of menus.

I also got sidetracked with another algorithm but anyone who would possibly be interested will notice it in the code.

obpacview

#!/usr/bin/perl
use strict;
use warnings;

use File::Path qw/make_path/;

# Global Variables (uppercase)
my $NAME = 'ObPacView';
my @MENUFIABLE = ('Depends On', 'Required By');
my $LOCAL_PKG_INFO_CMD = 'LC_ALL=C pacman -Qi';
my $LOCAL_PKG_LIST_CMD = 'LC_ALL=C pacman -Q';
my $CONFIG_DIR = &get_config_dir();

my $PKGS = {};
my %DEFINED_MENUS = ();



&main();


##########################
########## SUBS ##########
##########################

sub main()
{
  my $argv_md5sum = &get_argv_md5sum();
  print &get_pipemenu($argv_md5sum);
}



# escape characters for xml attribute strings
# this could probably be improved but meh, it works
sub escape_attr()
{
  return join('', map {$_ =~ m/[0-9a-zA-Z ]/ ? $_ : '&#'.ord($_).';'} split(//, $_[0]))
}



# get a unique identifier for the argument list, which should be a list of ordered fields
sub get_argv_md5sum()
{
  if (@ARGV)
  {
    my $cmd = "md5sum <<OBPACVIEWARGV\n".join(' ', @ARGV)."\nOBPACVIEWARGV\n";
    return substr(`$cmd`, 0, 32);
  }
  else
  {
    return 'default';
  }
}



sub get_config_dir()
{
  my $cdir;
  if (defined($ENV{'XDG_CONFIG_HOME'}))
  {
    $cdir = $ENV{'XDG_CONFIG_HOME'}.'/obpacview';
  }
  else
  {
    $cdir = $ENV{'HOME'}.'/.config/obpacview';
  }
  if (not -e $cdir)
  {
    make_path($cdir) or die "failed to create path \"$cdir\": $!";
  }
  return $cdir;
}



sub get_fields_array()
{
  my $field_tracker = $_[0];
  # I added this mostly for the sake of the algorithm itself.
  my @fields = @ARGV;
  if (not @fields)
  {
    my $last_field;
    while (%{$field_tracker})
    {
      foreach my $field( keys(%{$field_tracker}) )
      {
        my @precedents = keys(%{$field_tracker->{$field}});
        my $n = scalar(@precedents);
        if ($n == 0)
        {
          $last_field = $field;
          delete($field_tracker->{$field});
        }
        elsif ($n == 1)
        {
          my $candidate = $precedents[0];
          if (not defined($field_tracker->{$candidate}))
          {
            $last_field = $candidate;
          }
        }
      }
  
      unshift(@fields, $last_field);
  
      foreach my $field( keys(%{$field_tracker}) )
      {
        delete $field_tracker->{$field}->{$last_field} if defined($field_tracker->{$field}->{$last_field});
      }
    }
  }
  return @fields;
}



# prepend "_" to labels containing "_" to prevent Openbox from mangling names
sub get_label()
{
  my $label = $_[0];
  $label = '_' . $label if $label =~ m/_/;
  return &escape_attr($label);
}



sub get_local_pkg_info()
{
  # hash ref to store pkg info
  my $pkgs = {};
  
  # hash ref to order fields
  my $field_tracker = {};
  
  # load pkg info into array
  my @pkginfo = split(/\s*\n\s*\n\s*/, `$LOCAL_PKG_INFO_CMD`);

  # parse the pkg info for each pkg and load it into $pkgs
  foreach my $pkg (@pkginfo)
  {
    my $pkginfo = {};
    my $field;
    my $last_field;
    my $name;
    my $value;
    my @lines = split(/\s*\n/, $pkg);
    foreach my $line (@lines)
    {
      # If the line begins with a character, it's a new field,
      if ($line =~ m/^(\S[^:]*):(.+)$/)
      {
        $field = $1;
        $value = $2;
        $field =~ s/\s+$//;
      }
      # else it is a continuation of the previous field.
      else
      {
        $value = $line;
      }
      $value =~ s/^\s+//;
      $value =~ s/\s+$//;
      $name = $value if $field eq 'Name';
    
      # see comments below
      if (defined($last_field) and $field ne $last_field)
      {
        $field_tracker->{$last_field}->{$field}++;
      }
      $last_field = $field;
  
      # Ignore fields with no value.
      next if $value eq 'None';
  
      # Handle menufiable fields.
      if (grep {$field eq $_} @MENUFIABLE)
      {
        push( @{ $pkginfo->{$field} }, grep {$_ =~ m/\S/} split( /\s+/, $value) );
      }
      else
      {
        if (defined($pkginfo->{$field}))
        {
          $pkginfo->{$field} .= "\n" . $value;
        }
        else
        {
          $pkginfo->{$field} = $value;
        }
      }
    }
    $pkgs->{$name} = $pkginfo;
  }
  return ($pkgs, $field_tracker);
}



sub get_local_pkglist_md5sum()
{
  return substr(`$LOCAL_PKG_LIST_CMD | md5sum`, 0, 32);
}



sub get_pipemenu()
{
  my $argv_md5sum = $_[0];
  my $checkfile = $CONFIG_DIR.'/checkfile-'.$argv_md5sum;
  my $menufile = $CONFIG_DIR.'/menu-'.$argv_md5sum;
  my $menu;
  
  my $old_pkglist_md5sum = '';
  if (-e $checkfile)
  {
    open(my $fh, '<', $checkfile) or die "failed to open $checkfile: $!\n";
    $old_pkglist_md5sum = <$fh>;
    chomp $old_pkglist_md5sum;
    close $fh;
  }
  
  my $local_pkglist_md5sum = &get_local_pkglist_md5sum();
  
  # if the md5sums don't match, it's time to update the menu
  if ($local_pkglist_md5sum ne $old_pkglist_md5sum)
  {
    my ($PKGS, $field_tracker) = &get_local_pkg_info();
    my @fields = @ARGV ? @ARGV : &get_fields_array($field_tracker);
  
    # make the menu ids unique
    $NAME .= scalar(@fields) . time();

    $menu = "<openbox_pipe_menu>";

    my $last_char = '';
    foreach my $pkg (sort keys( %{$PKGS} ))
    {
      my $char = &escape_attr(lc(substr($pkg,0,1)));
      if ($char ne $last_char)
      {
        my $id = "$NAME-char-$char";
        $menu .= "</menu>" if $last_char ne '';
        $menu .= "<menu id=\"$id\" label=\"$char\">";
        $last_char = $char;
      }
      $menu .= &get_pkg_menu($PKGS->{$pkg}, undef, @fields);
    }
    $menu .= "</menu>";
    $menu .= "</openbox_pipe_menu>";
    
    open(my $fh, '>', $menufile) or die "failed to open $menufile: $!\n";
    print $fh $menu;
    close $fh;
    
    open($fh, '>', $checkfile) or die "failed to open $checkfile: $!\n";
    print $fh $local_pkglist_md5sum;
    close $fh;
  }
  else
  {
    open(my $fh, '<', $menufile) or die "failed to open $menufile: $!\n";
    {
      local $/;
      $menu = <$fh>;
    }
    close $fh;
  }
  
  return $menu;
}



sub get_pkg_menu()
{
  my ($pkg, $label, @fields) = @_;
  my $menu = '';
  
  my $pkgname = &get_label( $pkg->{'Name'} );
  my $id = "$NAME-pkg-$pkgname";
  if (defined($DEFINED_MENUS{$id}))
  {
    $menu .= "<menu id=\"$id\"/>";
  }
  else
  {
    $DEFINED_MENUS{$id}++;
    $label = $pkgname;# if not defined($label);
    $menu .= "<menu id=\"$id\" label=\"$label\">";
    foreach my $field (@fields)
    {
      next if not defined($pkg->{$field});
      if (grep {$field eq $_} @MENUFIABLE)
      {
        my @items = @{ $pkg->{$field} };
        my $n = scalar(@items);
        next if not $n > 0;
        $menu .= "<separator label=\"$field\"/>";
        foreach my $item (sort @items)
        {
          my $basename = $item;
          $basename =~ s/[>=].*//;
          if (defined($PKGS->{$basename}))
          {
            $menu .= &get_pkg_menu($PKGS->{$basename}, $item, @fields)
          }
          else
          {
            $menu .= "<item label=\"" . &get_label($item) . "\"/>";
          }
        }
      }
      else
      {
        $menu .= "<separator label=\"$field\"/>";
        foreach my $line (split(/\n/, $pkg->{$field}))
        {
          my $label = &get_label($line);
          $menu .= "<item label=\"$label\"/>";
        }
      }
    }
    $menu .= "</menu>";
  }
  return $menu;
}

Last edited by Xyne (2009-11-01 15:04:49)

Andrwe · 2009-10-25 13:15:36

Hi Xyne,

I like the idea of obpacview very much because you can get information about a package very fast.
That it the reason why I've written a perl script which does the idea of obpacview very fast and structured.
It would be nice if I could use the name obpacview for this.

#!/usr/bin/perl
use strict;
use warnings;

# Global variables for easy changing
my $path = "/scripts/obpacview";
my $pacmancmd = "pacman";
my $shellvars = "LC_ALL=C";
my @menufiable = ('Depends On', 'Required By');

# Get all letters depending on installed packages e.g. if no package starting with a is installed it wouldn't be in the returning array
sub get_letters()
{
    my @letters;
    my @lines;
    my $pacmanQ = `$shellvars $pacmancmd -Q`;
    my @pkgs = split(/\s*\n\s*\n\s*/, $pacmanQ);
    foreach my $pkgsprint (@pkgs)
    {
        push(@lines,split(/\s*\n/, $pkgsprint));
        foreach my $line (@lines)
        {
            my $curletter = substr($line, 0, 1);
            if (! $letters[-1])
            {
                push(@letters, $curletter);
            }
            if ($letters[-1] ne $curletter)
            {
                push(@letters, $curletter);
            }
        }
    }
    return @letters;
}

# Get all package which starts with given letter
sub get_pkgs()
{
    my @pkgarr;
    my @lines;
    my @pkgsorted;
    my $letter = $_[0];
    my $pacmanQ = `$shellvars $pacmancmd -Q`;
    my @pkgs = split(/\s*\n\s*\n\s*/, $pacmanQ);
    foreach my $pkg (@pkgs)
    {
        push(@lines,split(/\s*\n/, $pkg));
    }
    foreach my $line (@lines)
    {
        if ($letter eq substr($line, 0 ,1))
        {
            my @line1 = split(/\s/, $line);
            push(@pkgsorted, $line1[0]);
        }
    }
    return @pkgsorted
}

# Get information of given package and modify for printing
sub get_pkg_info()
{
    my @keys;
    my %pkginfo;
    my $pkg = $_[0];
    my $pacmanQi = `$shellvars $pacmancmd -Qi $pkg`;

    $pacmanQi =~ s/\n/?!/g;
    $pacmanQi =~ s/\s+/ /g;
    $pacmanQi =~ s/\?\!\s+/?!/g;
    $pacmanQi =~ s/\?\!/\n/g;

    my @lines = split(/\s*\n/, $pacmanQi);
    my $old_key;
    foreach my $line (@lines)
    {
        if ($line !~ /.*:.*/)
        {
            $pkginfo{$old_key} = $pkginfo{$old_key} . " " . $line;
        }
        if ($line =~ m/^(\S[^:]*):(.+)$/)
        {
            $old_key = $1;
            $pkginfo{$1} = $2;
        }
    }

    return %pkginfo;
}

# Build main menu with list of letters
sub get_main_menu()
{
    my @letters = get_letters();
    foreach my $letter (@letters)
    {
        print "<menu id=\"$letter\" label=\"$letter\" execute=\"$path $letter\"/>";
    }
}

# Build menu with list of package for given letter
sub get_sub_menu()
{
    my $letter = $_[0];
    my @pkgs = &get_pkgs($letter);
    foreach my $pkg (@pkgs)
    {
        print "<menu id=\"$pkg\" label=\"$pkg\" execute=\"$path pkg $pkg\" />"
    }
}

# Build menu with information of given package
sub get_pkg_menu()
{
    my $pkg = $_[0];
    my %pkginfo = &get_pkg_info($pkg);
    while ((my $k, my $v) = each(%pkginfo))
    {
            $k =~ s/(.*)\s/$1/;
            $v =~ s/\s(.*)/$1/;

            print "<separator label=\"$k\" />";
            if (grep {$k eq $_} @menufiable)
            {
                if ("$v" ne "None")
                {
                    my @splits = split(/\s/, $v);
                    foreach my $split (@splits)
                    {
                        my $value = $split;
                        $value =~ s/([^0-9a-zA-Z ])/'&#'.ord($1).';'/eg;
                        $split =~ s/[<>]?\=.*//g;
                        print "<menu id=\"$value\" label=\"$value\" execute=\"$path pkg $split\" />";
                    }
                }
                else
                {
                    print "<item label=\"$v\" />";
                }
            }
            else
            {
                my $value = $v;
                $value =~ s/(.*\_.*)/_$1/g;
                $value =~ s/([^0-9a-zA-Z ])/'&#'.ord($1).';'/eg;
                print "<item label=\"$value\" />";
            }
    }
}

# Print menu structure
print "<openbox_pipe_menu>";

if (@ARGV)
{
    if ("$ARGV[0]" ne "pkg")
    {
        &get_sub_menu($ARGV[0]);
    }
    else
    {
        &get_pkg_menu($ARGV[1]);
    }
}
else
{
    get_main_menu();
}

print "</openbox_pipe_menu>";

To get this script working just save the code in an executable file, change the value of the variable $path to the file and add the file as pipemenu to your menu.

Last edited by Andrwe (2009-10-25 13:26:14)

Xyne · 2009-11-01 11:38:49

Sorry, I missed your post.

I'd prefer to keep the name so that I could develop this further as I have some other ideas for it.

Maybe we could work on a single script together. I like your idea of organizing the packages in submenus for each letter but I'm not sure that multiple invocations of obpacview & pacman & openbox's pipemenu parser is really "very fast and structured". I didn't look very closely at your version but I've tried to use menu ids to avoid reduplication and only call pacman once. This could be improved by storing the output in file and only updating it when something has changed. That should be the fastest way to display the menu.

Andrwe · 2009-11-01 11:49:14

I would be honored to work with you on a script together.
I just have written it this way because it is faster then yours at the first load time.
The idea of using a file which would be updated could really be a better way, haven't thougth of this.

How can we be in contact and use same code base so we can work together?

Xyne · 2009-11-01 15:05:02

Andrwe wrote:

How can we be in contact and use same code base so we can work together?

Git would probably be the best way but that means I finally have to learn how to use git

I've rearranged the code a bit (cleaned up the existing code but introduced some clutter with new code). It now uses previously generated menu text to avoid rebuilding the menu. Let me know if it's faster than the method of multiple invocations that you were using. It creates an md5sum of "pacman -Q" to determine if the list has changed.

Last edited by Xyne (2009-11-01 15:06:13)

Andrwe · 2009-11-01 15:35:01

Xyne wrote:

Andrwe wrote:
How can we be in contact and use same code base so we can work together?
Git would probably be the best way but that means I finally have to learn how to use git

If you want to learn a really good repository system I would recommend mercurial.
But if want to use git I also don't have a problem.

I've rearranged the code a bit (cleaned up the existing code but introduced some clutter with new code). It now uses previously generated menu text to avoid rebuilding the menu. Let me know if it's faster than the method of multiple invocations that you were using. It creates an md5sum of "pacman -Q" to determine if the list has changed.

After the first run it is faster then my solution also after some changes.

Xyne · 2009-11-01 16:19:40

If you prefer Mercurial then I don't mind. I don't really know either so I don't really have a preference. I only suggested git because many people seem to recommend it.

Arch Linux

#1 2009-10-09 20:19:19

ObPacView: a generally useless installed-package viewer for Openbox

#2 2009-10-25 13:15:36

Re: ObPacView: a generally useless installed-package viewer for Openbox

#3 2009-11-01 11:38:49

Re: ObPacView: a generally useless installed-package viewer for Openbox

#4 2009-11-01 11:49:14

Re: ObPacView: a generally useless installed-package viewer for Openbox

#5 2009-11-01 15:05:02

Re: ObPacView: a generally useless installed-package viewer for Openbox

#6 2009-11-01 15:35:01

Re: ObPacView: a generally useless installed-package viewer for Openbox

#7 2009-11-01 16:19:40

Re: ObPacView: a generally useless installed-package viewer for Openbox

Board footer