# $Id: Util.pm 2666 2008-08-15 14:33:04Z comdog $ package Mac::Path::Util; use strict; use warnings; no warnings; use base qw(Exporter); use vars qw(@EXPORT_OK %EXPORT_TAGS $VERSION); use Cwd qw(getcwd); use Exporter; @EXPORT_OK = qw(DARWIN MACOS); %EXPORT_TAGS = ( 'system' => [ qw(DARWIN MACOS) ], ); $VERSION = '0.26'; my $Startup; =head1 NAME Mac::Path::Util - convert between darwin and Mac paths =head1 SYNOPSIS use Mac::Path::Util; my $path = Mac::Path::Util->new( "/Users/foo/file.txt" ); my $mac_path = $path->mac_path; =head1 DESCRIPTION THIS IS ALPHA SOFTWARE. SOME THINGS ARE NOT FINISHED. Convert between darwin (unix) and Mac file paths. This is not as simple as changing the directory separator. The Mac path has the volume name in it, whereas the darwin path leaves off the startup volume name because it is mounted as /. Mac::Path::Util can optionally use Mac::Carbon to determine the real startup volume name (off by default) if you have installed Mac::Carbon. You can use this module on other platforms too. Once the module has looked up the volume name, it caches it. If you want to reset the cache, use the clear_startup() method. Colons ( ":" ) in the darwin path become / in the Mac path, and forward slashes in the Mac path become colons in the darwin path. Mac paths do not have a leading directory separator for absolute paths. Normally, Mac paths that end in a directory name have a trailing colon, but this module cannot necessarily verify that since you may want to convert paths. =head2 Methods =over 4 =cut use constant DARWIN => 'darwin'; use constant MACOS => 'macos'; use constant DONT_KNOW => "Don't know"; use constant BAD_PATH => "Bad Path"; use constant TRUE => 'true'; use constant FALSE => 'false'; use constant LOCAL => 'local'; use constant REMOTE => 'remote'; use constant STARTUP => 'Startup'; =item new( PATH [, HASH ] ) The optional anonymous hash can have these values: type DARWIN or MACOS (explicitly state which sort of path with these symbolic constants) startup the name of the startup volume (if not defined, tries to use the startup volume on the local machine) =cut sub new { my $class = shift; my $path = shift; my $args = shift; my $type = DONT_KNOW unless ( $args->{type} && ( $args->{type} eq DARWIN or $args->{type} eq MACOS ) ); my $self = { starting_path => $path, type => $type, path => $path, use_carbon => ( $^O eq 'darwin' or $^O =~ /MacOS/ ), }; bless $self, $class; $self->{startup} = $args->{startup} || undef; $self->_identify; return if $self->{type} eq BAD_PATH; # we know that there is at least one colon in the path # if the type is MACOS if( $self->type eq MACOS ) { $self->{mac_path} = $self->path; # absolute paths do not start with colons if( index( $self->path, 0, 1 ) ne ":" ) { my( $volume )= $self->path =~ m/^(.+?):/g; $self->{volume} = $volume; } else { $self->{volume} = $self->_get_startup; $self->{startup} = $self->volume if $self->_is_startup( $self->{volume} ) eq TRUE; } } elsif( $self->type eq DARWIN ) { $self->{darwin_path} = $self->path; if( index( $self->path, 0, 1 ) eq "/" ) { $self->{volume} = $self->path =~ m|^/Volumes/(.*?)/?|g; } unless( defined $self->volume ) { $self->{volume} = $self->_get_startup; $self->{startup} = $self->volume if $self->_is_startup( $self->{volume} ) eq TRUE; } $self->_darwin2mac; } return $self; } =back =head2 Accessor methods =over 4 =item type =item path =item volume =item startup =item mac_path =item darwin_path =back =cut sub type { return $_[0]->{type} } sub path { return $_[0]->{path} } sub volume { return $_[0]->{volume} } sub startup { return $_[0]->{startup} } sub mac_path { return $_[0]->{mac_path} } sub darwin_path { return $_[0]->{darwin_path} } =head2 Setter methods =over 4 =item use_carbon( [ TRUE | FALSE ] ) Mac::Path::Util will try to use Mac::Carbon to determine the real startup volume name if you pass this method a true value and you have Mac::Carbon installed. Otherwise it will use a default startup volume name. =cut sub use_carbon { my $self = shift; $self->{use_carbon} = $_[0] ? 1 : 0; $self->clear_startup } sub _d2m_trans { my $name = shift; $name =~ tr|/:|:/|; return $name; } sub _darwin2mac { my $self = shift; my $name = $self->{starting_path}; $self->{mac_path} = do { # is this a relative url? if( substr( $name, 0, 1 ) ne "/" ) { my $path = ":" . _d2m_trans( $name ); $path; } # is this an absolute url with another Volume? elsif( $name =~ m|^/Volumes/([^/]+)(/.*)| ) { my $volume = $1; my $path = $2; $path = _d2m_trans( $path ); my $abs = $volume . $path; } # absolute path off of startup volume? elsif( substr( $name, 0, 1 ) eq "/" ) { my $volume = $self->_get_startup; my $path = _d2m_trans( $name ); my $abs = $volume . $path; } }; return $self->{mac_path}; } sub _mac2darwin { my $self = shift; my $name = shift; $name =~ tr|/:|:/|; return $name; } sub _identify { my $self = shift; my $colons = 0; my $slashes = 0; if ( defined $self->{starting_path} ) { $colons = $self->{starting_path} =~ tr/://; $slashes = $self->{starting_path} =~ tr|/||; } if( $colons == 0 and $slashes == 0 ) { $self->{type} = DONT_KNOW; } elsif( $colons != 0 and $slashes == 0 ) { $self->{type} = MACOS; } elsif( $colons == 0 and $slashes != 0 ) { $self->{type} = DARWIN; } elsif( $colons != 0 and $slashes != 0 ) { $self->{type} = DONT_KNOW; } } =item clear_startup Clear the cached startup volume name. The next lookup will reset the cache. =cut sub clear_startup { my $self = shift; delete $self->{startup} if ref $self; $Startup = undef; } sub _get_startup { my $self = shift; return $self->startup if defined $self->startup; return $Startup if defined $Startup; my $volume = do { if( $self->{use_carbon} and eval { require MacPerl } ) { (my $volume = scalar MacPerl::Volumes()) =~ s/^.+?:(.+)$/$1/; $volume; } else { STARTUP; } }; #print STDERR "I think the startup volume is [$volume]\n"; $Startup = $self->{startup} = $volume; return $volume; } sub _is_startup { my $self = shift; my $name = shift; $self->_get_startup unless defined $self->startup; $name eq $Startup ? TRUE : FALSE; } =back =head1 SOURCE AVAILABILITY This source is part of a SourceForge project which always has the latest sources in SVN, as well as all of the previous releases. http://sourceforge.net/projects/brian-d-foy/ If, for some reason, I disappear from the world, one of the other members of the project can shepherd this module appropriately. =head1 AUTHOR brian d foy, C<< >> =head1 COPYRIGHT AND LICENSE Copyright (c) 2002-2008 brian d foy. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut "See why 1984 won't be like 1984";