On Thu, May 8, 2008 at 1:02 PM, Mark J. Reed <[log in to unmask]> wrote:
> Thought some of you might be interested in the Perl script I used to
> restore Mac metadata on 200MB of font files that were written to
> MS-DOS-formatted Zip disks from OS 9.

I attached the script to that message, but apparently the listserv
silently discards attachments.  Since the script is only 76 lines
long, I'm including it in the body this message; please ignore if you
were not, in fact, interested. :)

#!/usr/bin/perl
#----------------------------------------------------------------------
# Restore metadata on files that were stored using OS 9 FAT filesystem
# conventions.   Must be run on HFS+.
# --
# Mark J. Reed, 2008
#----------------------------------------------------------------------
use Cwd;
use File::Copy;
use File::Find;
use MacPerl qw(:all);

use strict;
use warnings;

my $DIR_FILE       = 'FINDER.DAT';
my $DIR_BLOCK_SIZE = 2048;
my $DIR_ENTRY_SIZE = 92;
my $FORK_SUBDIR    = 'RESOURCE.FRK';
my $VALID_INDEX    = 40;
my $TYPE_INDEX     = 32;
my $CREATOR_INDEX  = 36;
my $NAME_8_3_INDEX = 80;

unshift(@ARGV, '.') unless @ARGV;

find(\&wanted, @ARGV);

sub wanted
{
    if (-d $_ && -r "$_/$DIR_FILE")
    {
        my $cwd = getcwd;
        chdir($_) or die;
        my $dir = $File::Find::name;
        print "Processing $dir...\n";
        my $fd = undef;

        unless (open($fd, "<$DIR_FILE"))
        {
           warn "Unable to open $dir/$DIR_FILE: $!\n";
           next;
        }

        while (my $size = read($fd, my $block, $DIR_BLOCK_SIZE))
        {
            for (my $offset=0;
                    $offset + $DIR_ENTRY_SIZE < $size;
                        $offset += $DIR_ENTRY_SIZE)
            {
                my $data = substr($block, $offset, $DIR_ENTRY_SIZE);
                next unless ord(substr($data, $VALID_INDEX, 1));
                my $fn = substr($data, 1, ord($data));
                print "\t$fn";
                if (! -f $fn)
                {
                    print " (skipping - not found)\n";
                    next;
                }
                print "\n";
                my $type = substr($data, $TYPE_INDEX, 4);
                my $creator = substr($data, $CREATOR_INDEX, 4);
                my $rfrk  = $FORK_SUBDIR . '/' .
                                substr($data, $NAME_8_3_INDEX, 11);
                $rfrk =~ s/\s+$//;
                SetFileInfo($creator, $type, $fn);
                if (-s $rfrk && ! -s "$fn/rsrc")
                {
                    copy($rfrk, "$fn/rsrc") or
                        warn "Could not restore resource fork on $fn: $!\n";
                }
            }
        }
        chdir($cwd);
    }
}



-- 
Mark J. Reed <[log in to unmask]>