r28659 - in /branches/upstream/libx11-freedesktop-desktopentry-perl: ./ current/ current/lib/ current/lib/X11/ current/lib/X11/FreeDesktop/ current/t/
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Sun Dec 28 07:01:04 UTC 2008
Author: ryan52-guest
Date: Sun Dec 28 07:01:01 2008
New Revision: 28659
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28659
Log:
[svn-inject] Installing original source of libx11-freedesktop-desktopentry-perl
Added:
branches/upstream/libx11-freedesktop-desktopentry-perl/
branches/upstream/libx11-freedesktop-desktopentry-perl/current/
branches/upstream/libx11-freedesktop-desktopentry-perl/current/ChangeLog
branches/upstream/libx11-freedesktop-desktopentry-perl/current/META.yml
branches/upstream/libx11-freedesktop-desktopentry-perl/current/Makefile.PL
branches/upstream/libx11-freedesktop-desktopentry-perl/current/README
branches/upstream/libx11-freedesktop-desktopentry-perl/current/lib/
branches/upstream/libx11-freedesktop-desktopentry-perl/current/lib/X11/
branches/upstream/libx11-freedesktop-desktopentry-perl/current/lib/X11/FreeDesktop/
branches/upstream/libx11-freedesktop-desktopentry-perl/current/lib/X11/FreeDesktop/DesktopEntry.pm
branches/upstream/libx11-freedesktop-desktopentry-perl/current/t/
branches/upstream/libx11-freedesktop-desktopentry-perl/current/t/use.t
Added: branches/upstream/libx11-freedesktop-desktopentry-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libx11-freedesktop-desktopentry-perl/current/ChangeLog?rev=28659&op=file
==============================================================================
--- branches/upstream/libx11-freedesktop-desktopentry-perl/current/ChangeLog (added)
+++ branches/upstream/libx11-freedesktop-desktopentry-perl/current/ChangeLog Sun Dec 28 07:01:01 2008
@@ -1,0 +1,27 @@
+ChangeLog
+=========
+
+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 $
Added: branches/upstream/libx11-freedesktop-desktopentry-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libx11-freedesktop-desktopentry-perl/current/META.yml?rev=28659&op=file
==============================================================================
--- branches/upstream/libx11-freedesktop-desktopentry-perl/current/META.yml (added)
+++ branches/upstream/libx11-freedesktop-desktopentry-perl/current/META.yml Sun Dec 28 07:01:01 2008
@@ -1,0 +1,10 @@
+# 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
Added: branches/upstream/libx11-freedesktop-desktopentry-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libx11-freedesktop-desktopentry-perl/current/Makefile.PL?rev=28659&op=file
==============================================================================
--- branches/upstream/libx11-freedesktop-desktopentry-perl/current/Makefile.PL (added)
+++ branches/upstream/libx11-freedesktop-desktopentry-perl/current/Makefile.PL Sun Dec 28 07:01:01 2008
@@ -1,0 +1,9 @@
+#!/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',
+);
Added: branches/upstream/libx11-freedesktop-desktopentry-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libx11-freedesktop-desktopentry-perl/current/README?rev=28659&op=file
==============================================================================
--- branches/upstream/libx11-freedesktop-desktopentry-perl/current/README (added)
+++ branches/upstream/libx11-freedesktop-desktopentry-perl/current/README Sun Dec 28 07:01:01 2008
@@ -1,0 +1,18 @@
+INSTALLATION
+
+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 $
Added: branches/upstream/libx11-freedesktop-desktopentry-perl/current/lib/X11/FreeDesktop/DesktopEntry.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libx11-freedesktop-desktopentry-perl/current/lib/X11/FreeDesktop/DesktopEntry.pm?rev=28659&op=file
==============================================================================
--- branches/upstream/libx11-freedesktop-desktopentry-perl/current/lib/X11/FreeDesktop/DesktopEntry.pm (added)
+++ branches/upstream/libx11-freedesktop-desktopentry-perl/current/lib/X11/FreeDesktop/DesktopEntry.pm Sun Dec 28 07:01:01 2008
@@ -1,0 +1,427 @@
+# $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<new()> 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<Gnome2::VFS> as a backend, see the C<PerlPanel::DesktopEntry>
+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<carp()> 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<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<group names> 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<C>', since locales
+inherit keys from the default locale. See the C<get_value()> 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<carp()> and return undef. There should always be at least one locale in the
+returned array - the default locale, 'C<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<C>' if omitted). If the
+requested key does not exist for a non-default C<$locale> of the form C<xx_YY>,
+then the module will search for a value for the C<xx> locale. If nothing is
+found, this method will attempt to return the value for the 'C<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<http://www.freedesktop.org/Standards/desktop-entry-spec>.
+
+=head1 AUTHOR
+
+Gavin Brown E<lt>gavin.brown at uk.comE<gt>.
+
+=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;
Added: branches/upstream/libx11-freedesktop-desktopentry-perl/current/t/use.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libx11-freedesktop-desktopentry-perl/current/t/use.t?rev=28659&op=file
==============================================================================
--- branches/upstream/libx11-freedesktop-desktopentry-perl/current/t/use.t (added)
+++ branches/upstream/libx11-freedesktop-desktopentry-perl/current/t/use.t Sun Dec 28 07:01:01 2008
@@ -1,0 +1,9 @@
+#!/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;
More information about the Pkg-perl-cvs-commits
mailing list