X11-FreeDesktop-DesktopEntry-0.04/0000775000076400007640000000000010171255306017114 5ustar gavingavin00000000000000X11-FreeDesktop-DesktopEntry-0.04/ChangeLog0000664000076400007640000000132410171255261020666 0ustar gavingavin00000000000000ChangeLog ========= v0.04 - 2005-01-12: The constructor has been fixed so that it won't carp when given empty data, so that programs using this module can create empty objects and populate the dataset themselves. Added a munge to the supplied locale if it's in the xx_YY.CHARSET format to strip off .CHARSET. Added a simple test script, and fixed a couple of ambiguous keys() calls that showed up with -w. v0.03 - 2005-01-03: Implemented modification of values, and serialisation using as_string(). Improved documentation. v0.02 - 2005-01-01: Forgot to change the new() method's name to new_from_data(). Oops. v0.01 - 2005-01-01: Initial release. -- $Id: ChangeLog,v 1.3 2005/01/12 17:09:52 jodrell Exp $ X11-FreeDesktop-DesktopEntry-0.04/META.yml0000664000076400007640000000052410165575303020373 0ustar gavingavin00000000000000# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: X11-FreeDesktop-DesktopEntry version: 0.01 version_from: lib/X11/FreeDesktop/DesktopEntry.pm installdirs: site requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 X11-FreeDesktop-DesktopEntry-0.04/lib/0000775000076400007640000000000010171255306017662 5ustar gavingavin00000000000000X11-FreeDesktop-DesktopEntry-0.04/lib/X11/0000775000076400007640000000000010171255306020233 5ustar gavingavin00000000000000X11-FreeDesktop-DesktopEntry-0.04/lib/X11/FreeDesktop/0000775000076400007640000000000010171255306022446 5ustar gavingavin00000000000000X11-FreeDesktop-DesktopEntry-0.04/lib/X11/FreeDesktop/DesktopEntry.pm0000664000076400007640000002667210171255236025456 0ustar gavingavin00000000000000# $Id: DesktopEntry.pm,v 1.9 2005/01/12 17:13:02 jodrell Exp $ # Copyright (c) 2005 Gavin Brown. All rights reserved. This program is # free software; you can redistribute it and/or modify it under the same # terms as Perl itself. package X11::FreeDesktop::DesktopEntry; use Carp; use vars qw($VERSION $ROOT_GROUP $DEFAULT_GROUP $DEFAULT_LOCALE @REQUIRED $VERBOSE $SILENT); use utf8; use strict; our $VERSION = '0.04'; our $ROOT_GROUP = '_root'; our $DEFAULT_GROUP = 'Desktop Entry'; our $DEFAULT_LOCALE = 'C'; our @REQUIRED = qw(Encoding Name Type); our $VERBOSE = 0; our $SILENT = 0; =pod =head1 NAME X11::FreeDesktop::DesktopEntry - an interface to Freedesktop.org .desktop files. =head1 SYNOPSIS use X11::FreeDesktop::DesktopEntry; my $entry = X11::FreeDesktop::DesktopEntry->new_from_data($data); print $entry->get_value('Name'); print $entry->Exec; $entry->set_value('Name', 'Example Program'); print $entry->as_string; $entry->reset; =head1 DESCRIPTION This module provides an object-oriented interface to files that comply with the Freedesktop.org desktop entry specification. You can query the file for available values, modify them, and also get locale information as well. =head1 CONSTRUCTOR X11::FreeDesktop::DesktopEntry doesn't have the standard C constructor. This allows subclasses to implement their own backend-specific constructor without needing to re-implement the constructor, which can be a pain I<(for an example subclass that uses L as a backend, see the C module in the PerlPanel distribution)>. my $entry = X11::FreeDesktop::DesktopEntry->new_from_data($data); If there is an error reading or parsing the data, the constructor will C and return an undefined value. =cut sub new_from_data { my ($package, $data) = @_; my $self = { _raw => $data }; bless($self, $package); return undef unless ($self->parse); return $self; } sub parse { my $self = shift; my @lines = split(/[\r\n]/, $self->{_raw}); my ($current_group, $last_key); for (my $i = 0 ; $i < scalar(@lines) ; $i++) { chomp(my $line = $lines[$i]); if ($line =~ /^[\s\t\r\n]*$/) { # ignore whitespace: next; } elsif ($line =~ /^\s*\#(.+)$/) { # the spec requires that we be able to preserve comments, so # we need to note the position that the comment occurred at, relative # to the current group and last key: push(@{$self->{comments}->{(defined($current_group) ? $current_group : $ROOT_GROUP)}->{$last_key}}, $1); } elsif ($line =~ /^\[([^\[]+)\]/) { # defines a new group: $current_group = $1; $self->{data}->{$current_group} = {}; } elsif ($current_group ne '') { # got a key=value pair: my ($key, $value) = split(/\s*=\s*/, $line, 2); $last_key = $key; my $locale = $DEFAULT_LOCALE; # check for the Key[postfix] format: if ($key =~ /\[([^\[]+)\]$/) { $locale = $1; $key =~ s/\[$locale\]$//; } if (defined($self->{data}->{$current_group}->{$key}->{$locale})) { carp(sprintf( 'Parse error on %s line %s: value already exists for \'%s\' in \'%s\', skipping later entry', $self->{uri}, $i+1, $last_key, $current_group, )) if ($VERBOSE == 1); } else { $self->{data}->{$current_group}->{$key}->{$locale} = $value; } } else { # an error: carp(sprintf('Parse error on %s line %s: no group name defined', $self->{uri}, $i+1)) unless ($SILENT == 1); return undef; } } return 1; } =pod =head1 METHODS $entry->is_valid($locale); Returns a true or false valid depending on whether the required keys exist for the given C<$locale>. A list of the required keys can be found in the Freedesktop.org specification. If C<$locale> is omitted, it will default to 'C'. =cut sub is_valid { my ($self, $locale) = @_; $locale = (defined($locale) ? $locale : $DEFAULT_LOCALE); foreach my $key (@REQUIRED) { if (!defined($self->get_value($key, $DEFAULT_GROUP, $locale))) { return undef; } } return 1; } =pod my @groups = $entry->groups; This returns an array of scalars containing the I included in the file. Groups are defined by a line like the following in the file itself: [Desktop Entry] A valid desktop entry file will always have one of these, at the top. =cut sub groups { return keys(%{$_[0]->{data}}); } =pod $entry->has_group($group); Returns true or false depending on whether the file has a section with the name of C<$group>. =cut sub has_group { return defined($_[0]->{data}->{$_[1]}); } =pod my @keys = $entry->keys($group, $locale); Returns an array of the available keys in C<$group> and the C<$locale> locale. Both these values revert to defaults if they're undefined. When C<$locale> is defined, the array will be folded in with the keys from 'C', since locales inherit keys from the default locale. See the C method for another example of this inheritance. =cut sub keys { my ($self, $group, $locale) = @_; $group = (defined($group) ? $group : $DEFAULT_GROUP); my %keys; foreach my $key (CORE::keys(%{$self->{data}->{$group}})) { # add the key if $locale is defined and a value exists for that locale, or if $locale isn't defined: $keys{$key}++ if ((defined($locale) && defined($self->{data}->{$group}->{$key}->{$locale})) || !defined($locale)); } if ($locale ne $DEFAULT_LOCALE) { # fold in the keys for the default locale: foreach my $key ($self->keys($group, $DEFAULT_LOCALE)) { $keys{$key}++; } } return sort(keys(%keys)); } =pod $entry->has_key($key, $group); Returns true or false depending on whether the file has a key with the name of C<$key> in the C<$group> section. If C<$group> is omitted, then the default group (C<'Desktop Entry'>) will be used. =cut sub has_key { return defined($_[0]->{data}->{defined($_[2]) ? $_[2] : $DEFAULT_GROUP}->{$_[1]}); } =pod my @locales = $entry->locales($key, $group); Returns an array of strings naming all the available locales for the given C<$key>. If C<$key> or C<$group> don't exist in the file, this method will C and return undef. There should always be at least one locale in the returned array - the default locale, 'C'. =cut sub locales { my ($self, $key, $group) = @_; $group = (defined($group) ? $group : $DEFAULT_GROUP); if (!$self->has_group($group)) { carp(sprintf('get_value(): no \'%s\' group found', $group)) if ($VERBOSE == 1); return undef; } elsif (!$self->has_key($key, $group)) { carp(sprintf('get_value(): no \'%s\' key found in \'%s\'', $key, $group)) if ($VERBOSE == 1); return undef; } else { return CORE::keys(%{$self->{data}->{$group}->{$key}}); } } =pod my $string = $entry->get_value($key, $group, $locale); Returns the value of the key named by C<$key>. C<$group> is optional, and will be set to the default if omitted (see above). C<$locale> is also optional, and defines the locale for the string (defaults to 'C' if omitted). If the requested key does not exist for a non-default C<$locale> of the form C, then the module will search for a value for the C locale. If nothing is found, this method will attempt to return the value for the 'C' locale. If this value does not exist, this method will return undef. =cut sub get_value { my ($self, $key, $group, $locale) = @_; $group = (defined($group) ? $group : $DEFAULT_GROUP); $locale = (defined($locale) ? $locale : $DEFAULT_LOCALE); ($locale, undef) = split(/\./, $locale, 2); # in case locale is of the form xx_YY.UTF-8 my $rval; if (!defined($self->{data}->{$group}->{$key}->{$locale})) { if ($locale =~ /^[a-z]{2}_[A-Z]{2}$/) { my ($base, undef) = split(/_/, $locale, 2); $rval = $self->get_value($key, $group, $base); } else { $rval = ($locale eq $DEFAULT_LOCALE ? undef : $self->get_value($key, $group, $DEFAULT_LOCALE)); } } else { $rval = $self->{data}->{$group}->{$key}->{$locale}; } utf8::decode($rval); return $rval; } =pod $entry->set_value($key, $value, $locale, $group); This method sets the value of the C<$key> key in the C<$locale> locale and C<$group> group to be C<$value>. If C<$locale> and C<$group> are omitted, the defaults are used. C<$value> is always interpreted as a string. This method always returns true. =cut sub set_value { my ($self, $key, $value, $locale, $group) = @_; $group = (defined($group) ? $group : $DEFAULT_GROUP); $locale = (defined($locale) ? $locale : $DEFAULT_LOCALE); ($locale, undef) = split(/\./, $locale, 2); # in case locale is of the form xx_YY.UTF-8 $self->{data}->{$group}->{$key}->{$locale} = $value; return 1; } =pod my $data = $entry->as_string; This method returns a scalar containing the full entry in .desktop format. This data can then be used to write the entry to disk. =cut sub as_string { my $self = shift; my $data; if (defined($self->{comments}->{$ROOT_GROUP})) { foreach my $key (CORE::keys(%{$self->{comments}->{$ROOT_GROUP}})) { foreach my $comment (@{$self->{comments}->{$ROOT_GROUP}->{$key}}) { $data .= sprintf("# %s\n", $comment); } } } foreach my $group (sort($self->groups)) { $data .= sprintf("[%s]\n", $group); if (defined($self->{comments}->{$group}) && defined($self->{comments}->{$group}->{''})) { foreach my $comment (@{$self->{comments}->{$group}->{''}}) { $data .= sprintf("# %s\n", $comment); } } foreach my $key (sort($self->keys($group))) { foreach my $locale (sort($self->locales($key, $group))) { my $name = sprintf('%s%s', $key, ($locale ne $DEFAULT_LOCALE ? sprintf('[%s]', $locale) : '')); $data .= sprintf("%s=%s\n", $name, $self->get_value($key, $group, $locale)); if (defined($self->{comments}->{$group}) && defined($self->{comments}->{$group}->{$name})) { foreach my $comment (@{$self->{comments}->{$group}->{$name}}) { $data .= sprintf("# %s\n", $comment); } } } } $data .= "\n"; } return $data; } =pod $entry->reset; This method restores the entry to its initial state - it undoes any changes made to the values stored in the entry. =cut sub reset { my $self = shift; $self->{data} = {}; return $self->parse; } =pod =head1 CONVENIENCE METHODS my $name = $entry->Name($locale); my $generic_name = $entry->GenericName($locale); my $comment = $entry->Comment($locale); my $type = $entry->Type($locale); my $icon = $entry->Icon($locale); my $exec = $entry->Exec($locale); my $url = $entry->URL($locale); my $startup_notify = $entry->StartupNotify($locale); These methods are shortcuts for the mostly commonly accessed fields from a desktop entry file. If undefined, $locale reverts to the default. =cut sub Name { $_[0]->get_value('Name', $DEFAULT_GROUP, $_[1]) } sub GenericName { $_[0]->get_value('GenericName', $DEFAULT_GROUP, $_[1]) } sub Comment { $_[0]->get_value('Comment', $DEFAULT_GROUP, $_[1]) } sub Type { $_[0]->get_value('Type', $DEFAULT_GROUP, $_[1]) } sub Icon { $_[0]->get_value('Icon', $DEFAULT_GROUP, $_[1]) } sub Exec { $_[0]->get_value('Exec', $DEFAULT_GROUP, $_[1]) } sub URL { $_[0]->get_value('URL', $DEFAULT_GROUP, $_[1]) } sub StartupNotify { return ($_[0]->get_value('StartupNotify', $DEFAULT_GROUP, $_[1]) eq 'true' ? 1 : undef) } =pod =head1 NOTES Please note that according to the Freedesktop.org spec, key names are case-sensitive. =head1 SEE ALSO The Freedesktop.org Desktop Entry Specification at L. =head1 AUTHOR Gavin Brown Egavin.brown@uk.comE. =head1 COPYRIGHT Copyright (c) 2005 Gavin Brown. This program is free software, you can use it and/or modify it under the same terms as Perl itself. =cut 1; X11-FreeDesktop-DesktopEntry-0.04/README0000664000076400007640000000055210165575037020007 0ustar gavingavin00000000000000INSTALLATION To install this module type the following: perl Makefile.PL make make test make install COPYRIGHT AND LICENCE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (C) 2003 Gavin Brown. All rights reserved. -- $Id: README,v 1.1.1.1 2005/01/01 19:29:35 jodrell Exp $ X11-FreeDesktop-DesktopEntry-0.04/t/0000775000076400007640000000000010171255306017357 5ustar gavingavin00000000000000X11-FreeDesktop-DesktopEntry-0.04/t/use.t0000664000076400007640000000025710170322000020325 0ustar gavingavin00000000000000#!/usr/bin/env perl -w # $Id: use.t,v 1.1 2005/01/09 21:37:04 jodrell Exp $ use strict; use Test; BEGIN { plan tests => 1 } use X11::FreeDesktop::DesktopEntry; ok(1); exit; X11-FreeDesktop-DesktopEntry-0.04/Makefile.PL0000664000076400007640000000035210165575037021077 0ustar gavingavin00000000000000#!/usr/bin/perl # $Id: Makefile.PL,v 1.1.1.1 2005/01/01 19:29:35 jodrell Exp $ use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'X11::FreeDesktop::DesktopEntry', 'VERSION_FROM' => 'lib/X11/FreeDesktop/DesktopEntry.pm', );