MacOSX::File::Info - Gets/Sets (HFS) File Attributes

  use MacOSX::File::Info;
  $finfo = MacOSX::File::Info->get($path);
  $finfo->type('TEXT');
  $finfo->creator('ttxt');
  $finfo->flags(-invisible => 1);
  $finfo->set;

  L<MacPerl>
  F</Developer/Tools/GetFileInfo>
  F</Developer/Tools/SetFile>

package MacOSX::File::Info;

use 5.006;
use strict;
use warnings;
use Carp;

our $RCSID = q$Id: Info.pm,v 0.70 2005/08/09 15:47:00 dankogai Exp $;
our $VERSION = do { my @r = (q$Revision: 0.70 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
our $DEBUG;

require Exporter;
require DynaLoader;
use AutoLoader;

our @ISA = qw(Exporter DynaLoader);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use MacOSX::File::Info ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.

our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
		 getfinfo
		 setfinfo
		 );

bootstrap MacOSX::File::Info $VERSION;
use MacOSX::File;

# Preloaded methods go here.

sub DESTROY{
    $DEBUG or return;
    carp "Destroying ", __PACKAGE__;
    return;
}

sub getfinfo{
    my ($path) = @_;
    my $self = xs_getfinfo($path);
    defined $self or return;
    bless $self;
}

sub get{
    my ($class, $path) = @_;
    my $self = xs_getfinfo($path);
    defined $self or return;
    bless $self => $class;
}

sub setfinfo{
    my ($info, $path) = @_;
    ref $info eq __PACKAGE__ or return;
    $path ||= ""; # to keep warnings quiet;
    return !xs_setfinfo(@$info, $path);
}

sub set{
    my ($self, $path) = @_;
    ref $self eq __PACKAGE__ or return;
    $path ||= ""; # to keep warnings quiet;
    return !xs_setfinfo(@$self, $path);
}

sub clone{
    my $self = shift;
    my (@new) = @$self;
    bless \@new, (ref $self);
}

# Construct accessor methods all at once

my %_ro = (
	   ref        => 0,
	   nodeFlags  => 1,
	   );

while(my($field, $index) = each %_ro){
    no strict 'refs';
    *$field = sub { $_[0]->[$index] };
}

my %_rw = (
	   type              => 2,
	   creator           => 3,
	   fdFlags           => 4,
	   ctime             => 5,
	   mtime             => 6,
	   );


while(my($field, $index) = each %_rw){
    no strict 'refs';
    *$field = sub  {
	my $self = shift;
	@_ and $self->[$index] = shift;
	$self->[$index];
    };
}

use MacOSX::File::Constants;

my %Key2Letter =
    qw(
       -alias      a
       -invisible  v
       -bundle     b
       -system     s
       -stationery t
       -customicon c
       -locked     l
       -inited     i
       -noinit     n
       -shared     m
       -hiddenx    e
       -desktop    d
       );
my %Letter2Key = reverse %Key2Letter;
my @Letters    = qw(a v b s t c l i n m e d);
my %key2Flags = 
    (
     -alias      =>  kIsAlias,
     -invisible  =>  kIsInvisible,
     -bundle     =>  kHasBundle,
     -system     =>  kNameLocked,
     -stationery =>  kIsStationery,
     -customicon =>  kHasCustomIcon,
     -locked     =>  kFSNodeLockedMask,
     -inited     =>  kHasBeenInited,
     -noinit     =>  kHasNoINITs,
     -shared     =>  kIsShared,
     -hiddenx    =>  kIsHiddenExtention,
     -desktop    =>  kIsOnDesk,
     );

sub locked{
    my $self = shift;
    return $self->nodeFlags & kFSNodeLockedMask;
}

sub lock{
    my $self = shift;
    $self->[1] = $self->nodeFlags | kFSNodeLockedMask;
    return $self;
}

sub unlock{
    my $self = shift;
    $self->[1] = $self->nodeFlags & ~kFSNodeLockedMask;
    return $self;
}

sub flags{
    my $self = shift;
    my ($fdFlags, $nodeFlags) = ($self->fdFlags, $self->nodeFlags);
    my %attrib = (
		  -alias      => $fdFlags & kIsAlias,
		  -invisible  => $fdFlags & kIsInvisible,
		  -bundle     => $fdFlags & kHasBundle,
		  -system     => $fdFlags & kNameLocked,
		  -stationery => $fdFlags & kIsStationery,
		  -customicon => $fdFlags & kHasCustomIcon,
		  -locked     => $nodeFlags & kFSNodeLockedMask,
		  -inited     => $fdFlags & kHasBeenInited,
		  -noinit     => $fdFlags & kHasNoINITs,
		  -shared     => $fdFlags & kIsShared,
		  -hiddenx    => $fdFlags & kIsHiddenExtention,
		  -desktop    => $fdFlags & kIsOnDesk,
		  );
    my $attrib = "";
    unless (@_){
	wantarray and return %attrib;
	for my $l (@Letters){
	    $attrib .=  $attrib{$Letter2Key{$l}} ? uc($l) : $l;
	}
	return $attrib;
    }
    if (scalar(@_) == 1){ # Letter notation
	my $letters = shift;
	for my $l (map { chr } unpack("C*", $letters)){
	    $attrib{$Letter2Key{lc($l)}} = ($l =~ tr/[A-Z]/[A-Z]/) ? 1 : 0;
	}
    }else{
	my %args = @_;
	for my $k (keys %args){
	    exists $attrib{$k} and $attrib{$k} = $args{$k};
	}
    }
    $fdFlags = 0;
    for my $k (keys %attrib){
	if ($k eq '-locked'){
	    $attrib{$k} ? $self->lock : $self->unlock;
	}else{
	    $fdFlags |= $attrib{$k} ? $key2Flags{$k} : 0;
	}
    }
    $self->fdFlags($fdFlags);

    defined wantarray or return;
    wantarray and return %attrib;
    for my $l (@Letters){
	$attrib .=  $attrib{$Letter2Key{$l}} ? uc($l) : $l;
    }
    return $attrib;
}
# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__