MacOSX::File::Catalog - Get (HFS) Catalog Information for that file

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

  $catalog->locked
  $catalog->lock
  $catalog->unlock

    $catalog->ref              Used Internally to store FSRef
    $catalog->nodeFlags        see lock() method
    $catalog->volume           vRefnum there of. Corresponds to st_dev
    $catalog->parentDirID      dirID thereof 
                               equiv. to lstat(dirname($path))->ino;
    $catalog->nodeID           nodeID thereof
                               equiv. to lstat($path)->ino;
    $catalog->sharingFlags    
    $catalog->userPrivileges
    $catalog->valence           

package MacOSX::File::Catalog;

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

our $RCSID = q$Id: Catalog.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 };

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::Catalog ':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(
		 getcatalog
		 setcatalog
		 );

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

# Preloaded methods go here.

use MacOSX::File::Constants;

sub getcatalog{
    my ($path) = @_;
    my $self = xs_getcatalog($path) or return;
    @$self or return;
    bless $self;
}

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

sub setcatalog{
    my ($catalog, $path) = @_;
    ref $catalog eq __PACKAGE__ or return;
    return !xs_setcatalog($catalog, $path);
}

sub set{
    my ($self, $path) = @_;
    ref $self eq __PACKAGE__ or return;
    return !xs_setcatalog($self, $path);
}

sub dump{
    use POSIX qw(strftime);
    my $s = shift;
    my $t2s = sub { 
	strftime("%Y.%m.%d %H:%M:%S", localtime($_[0]))
	    . "." . ($_[0]-int($_[0]));
	};
    my $octlist = sub { join ",", map {sprintf "0%o" ,$_} @_ };
    return 
	join("\n",
	     "(FSRef)",
	     sprintf("nodeFlags =>                  0x%04x", $s->[1]),
	     sprintf("volume =>                     %6d", $s->[2]),
	     sprintf("parentDirID =>            0x%08x", $s->[3]),
	     sprintf("nodeID =>                 0x%08x", $s->[4]),
	     sprintf("sharingFlags =>                 0x%02x", $s->[5]),
	     sprintf("userPrivileges =>               0x%02x", $s->[6]),
	     sprintf("createDate =>             %s", $t2s->($s->[7])),
	     sprintf("contentModDate =>         %s", $t2s->($s->[8])),
	     sprintf("attributeModDate =>       %s", $t2s->($s->[9])),
	     sprintf("accessDate =>             %s", $t2s->($s->[10])),
	     sprintf("backupDate =>             %s", $t2s->($s->[11])),
	     sprintf("permissions =>            ["),
	     sprintf("                          %10d, # uid", $s->[12][0]),
	     sprintf("                          %10d, # gid", $s->[12][1]),
	     sprintf("                             0%6o, # mode", $s->[12][2]),
	     sprintf("                          0x%08x, # device", $s->[12][3]),
	     sprintf("                          ]"),
	     sprintf("finderInfo =>      "),
	     sprintf(" fdType =>                    '%s'",  $s->[13][0]),
	     sprintf(" fdCreator =>                 '%s'",  $s->[13][1]),
	     sprintf(" fdFlags =>                   0x%04x", $s->[13][2]),
	     sprintf(" fdLocation =>                [%s]", 
		     join(",", @{$s->[13][3]})),
	     sprintf(" fdFldr =>                    0x%04x", $s->[13][4]),
	     sprintf("extFinderInfo =>      "),
	     sprintf("  fdIconID =>                 0x%04x", $s->[14][0]),
	     sprintf("  fdScript =>                 0x%04x", $s->[14][1]),
	     sprintf("  fdXFlags =>                   0x%02x", $s->[14][2]),
	     sprintf("  fdComment =>                  0x%02x", $s->[14][3]),
	     sprintf("  fdPutAway =>            0x%08x", $s->[14][4]),
	     sprintf("dataLogicalSize =>  %16.0f", $s->[15]),
	     sprintf("dataPhysicalSize => %16.0f", $s->[16]),
	     sprintf("rsrcLogicalSize =>  %16.0f", $s->[17]),
	     sprintf("rsrcPhysicalSize => %16.0f", $s->[18]),
	     sprintf("valence =>                0x%08x", $s->[19]),
	     sprintf("textEncodingHint =>       0x%08x", $s->[20]),
	     "\n");
}

# Construct accessor methods all at once

my %_ro = 
    (
     ref              => 0,
     nodeFlags        => 1,
     volume           => 2,
     parentDirID      => 3,
     nodeID           => 4,
     sharingFlags     => 5,
     userPrivileges   => 6,
     dataLogicalSize  => 15,
     dataPhysicalSize => 16,
     rsrcLogicalSize  => 17,
     rsrcPysicalSize  => 18,
     valence          => 19,
     );

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

my  %_rw_scalar =
    (
     createDate       => 7,
     contentModDate   => 8,
     attributeModDate => 9,
     accessDate       => 10,
     backupDate       => 11,
     textEncodingHint => 20, 
     );

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

my %_rw_aref = 
    (
     permissions      => 12,
     finderInfo       => 13,
     extFinderInfo    => 14,
     );

while(my($field, $index) = each %_rw_aref){
    no strict 'refs';
    *$field = sub { 
	my $self = shift;
	@_ or return $self->[$index];
        for(my $i = 0; $i < $#_; $i++){
	    $self->[$index][$i] = $_[$i];
	}
	return $self->[$index];
    };
}

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

# Autoload methods go after =cut, and are processed by the autosplit program.

1;
__END__