| Subject: | Patch to support Gnome paths |
Tested with Ubuntu Karmic + perl 5.10.0.
I've also created a simple debugging code which can be placed into eg/list.pl and can be used to test code changes quicky and is also an example program.
Cheers,
Burak
I've also created a simple debugging code which can be placed into eg/list.pl and can be used to test code changes quicky and is also an example program.
Cheers,
Burak
| Subject: | Unix.pm.patch |
--- lib/File/HomeDir/Unix.pm.old 2010-01-02 18:30:03.000000000 +0200
+++ lib/File/HomeDir/Unix.pm 2010-01-04 04:32:16.392472932 +0200
@@ -13,9 +13,11 @@
@ISA = 'File::HomeDir::Driver';
}
+use constant IS_GNOME => $ENV{DESKTOP_SESSION} && $ENV{DESKTOP_SESSION} eq 'gnome';
-
-
+my %PATH = ( # cache
+ gnome => undef,
+);
#####################################################################
# Current User Methods
@@ -57,34 +59,63 @@
}
# On unix by default, everything is under the same folder
-sub my_desktop {
- shift->my_home;
-}
-
-sub my_documents {
- shift->my_home;
-}
sub my_data {
shift->my_home;
}
-sub my_music {
- shift->my_home;
-}
-
-sub my_pictures {
- shift->my_home;
+BEGIN {
+ my @folders = qw(
+ my_desktop
+ my_documents
+ my_music
+ my_pictures
+ my_videos
+ );
+ no strict qw(refs);
+ foreach my $name ( @folders ) {
+ *{$name} = sub {
+ my $self = shift;
+ if ( IS_GNOME ) {
+ my $path = $self->_user_dirs_gnome( $name );
+ return $path if $path;
+ }
+ return $self->my_home;
+ };
+ }
}
-sub my_videos {
- shift->my_home;
+sub _user_dirs_gnome {
+ my($self, $name) = @_;
+ if ( ! $PATH{gnome} ) {
+ $PATH{gnome} = {};
+ my $home = $self->my_home;
+ return if ! -d $home;
+ my $conf = $home . '/.config/user-dirs.dirs';
+ return if ! -e $conf || ! -r _ || -d _;
+ # IO::File is safer if we're targeting 5.5.3 minimum.
+ require IO::File;
+ my $FH = IO::File->new;
+ if ( ! $FH->open( $conf, '<' ) ) {
+ warn "Error opening $conf for reading even though it exists: $!\n";
+ return;
+ }
+ while ( defined( my $line = <$FH> ) ) {
+ chomp $line;
+ next if $line =~ m{^#};
+ #next if $line !~ m{^XDG_};
+ my($name, $value) = split m{=}, $line, 2;
+ $value =~ tr/"//d;
+ $value =~ s{\$HOME}{$home}g;
+ $name =~ s{XDG_(.+?)_DIR}{$1};
+ $PATH{gnome}->{ 'my_' . lc $name } = $value;
+
+ }
+ $FH->close || die "Unable to close $conf: $!";
+ }
+ return $PATH{gnome}->{ $name };
}
-
-
-
-
#####################################################################
# General User Methods
| Subject: | list.pl |
#!/usr/bin/perl -w
use strict;
use File::HomeDir;
printf "*** Using File::HomeDir v%s from %s\n\n",
File::HomeDir->VERSION,
$INC{'File/HomeDir.pm'};
report( sort grep { /^my_/ } keys %File::HomeDir:: );
print "\n";
report( sort grep { /^users_/ } keys %File::HomeDir:: );
sub report {
my @list = @_;
foreach my $meth ( @list ) {
(my $name = $meth) =~ tr/_/ /;
my $value = File::HomeDir->$meth();
printf "%s: %s\n", $name, defined $value ? $value : '<undefined>';
}
}
1;
__END__
=pod
=head1 NAME
list.pl - Lists the available directory names and full paths
=head1 DESCRIPTION
Lists the available directory names and full paths (if available).
Can be used for debugging new File::HomeDir versions.
=cut