view release on metacpan or  search on metacpan

Info/Info.pm  view on Meta::CPAN

MacOSX uses Unix notion of Epoch.  (FYI MacPerl uses Mac notion of
Epoch). 

These methods accept fractional numbers since Carbon supports it.  It
also accepts numbers larger than UINT_MAX for the same reason.

=item $finfo->fdflags($fdflags)

Gets and sets fdflags values.  However, the use of this method is
discouraged unless you are happy with bitwise operation.  Use
$finfo->flags method instead.

  ex)
    $finfo->fdflags($finfo->fdflags | kIsInvisible)
    # makes the file invisible

=cut

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];
    };
}


=item $flags = $finfo->flags($attributes), %flags = $finfo->flags(%attributes)

Gets and sets fdflags like /Developer/Tools/SetFile.  You can use
SetFile-compatible letter notation or more intuitive args-by-hash
notation.


When you use Attribute letters and corresponding swithes as
follows. Uppercase to flag and lowercase to flag.

    Letter Hash key         Description
    -----------------------------------
    [Aa]   -alias           Alias file
    [Vv]   -invisible       Invisible*
    [Bb]   -bundle          Bundle
    [Ss]   -system          System (name locked)
    [Tt]   -stationery      Stationary
    [Cc]   -customicon      Custom icon*
    [Ll]   -locked          Locked
    [Ii]   -inited          Inited*
    [Nn]   -noinit          No INIT resources
    [Mm]   -shared          Shared (can run multiple times)
    [Ee]   -hiddenx         Hidden extension*
    [Dd]   -desktop         Desktop*

Attributes with asterisk can be applied to folders and files.  Any
other can be applied to files only.

  ex)
    $attr = $finfo->flags("avbstclinmed"); 
    # unflag eveythinng
    $attr = $finfo->flags("L");
    # locks file with the rest of attributes untouched
    $attr = $finfo->flags(-locked => 1);
    # same thing but more intuitive

On scalar context, it returns attrib. letters.  On list context, it
returns hash notation shown above;

=back

=cut

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__


=head1 AUTHOR

Dan Kogai <dankogai@dan.co.jp>

=head1 SEE ALSO

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

=head1 COPYRIGHT

Copyright 2002 Dan Kogai <dankogai@dan.co.jp>

This library is free software; you can redistribute it
and/or modify it under the same terms as Perl itself.