[Date Prev][Date Next][Thread Prev][Thread Next] [Search] [Date Index] [Thread Index]
[MacPerl] (un)?tarzgipme

To: mac-perl@iis.ee.ethz.ch
Subject: [MacPerl] (un)?tarzgipme
From: Chris Nandor <pudge@pobox.com>
Date: Sat, 9 Jan 1999 12:07:53 -0500
Here are two programs, one for module developers/porters, one for users.

untargzipme takes a tarred and gzipped archive and unpacks it, as you would
expect.  It by default converts newlines in text files, and demacbinarizes
binary files that end in .bin.

targzipme is the file that creates these archives.  It has three options on
creation: guess on text and binary files for newline conversion and
macbinarizing, do no conversion, or bring up a list of available files.

Both scripts require the following modules not included with MacPerl:

    Archive::Tar      http://www.cpan.org/modules/by-module/Archive/
    Compress::Zlib    http://www.cpan.org/authors/id/CNANDOR/
    Mac::Conversions  ftp://ftp.clark.net/ftp/pub/schinder/Conversions.pm
    Convert::BinHex   http://www.cpan.org/modules/by-module/Convert/

While you are at it, also pick up File::Spec at:

    http://www.cpan.org/modules/File/

And if you don't have them, you should take this time to get Paul
Schinder's Fixed Library Routines for AutoLoader and Exporter:

    ftp://ftp.clark.net/ftp/pub/schinder/Fixed_Library_Routines/

Note that Compress::Zlib is built for MacPPC and MacCFM68K.  If you have a
non-CFM68K MacPerl, you cannot run any of this.  Also note that MacPerl
might need extra RAM to run it all; I would guess that 8MB would be safe,
but feel free to report to the list what your requirements are.

This is phase one of the new system we're trying to work out.
Porters/developers can use tarzipme to create their archives, without
needing to spend time doing anything special to binary files, converting
newlines, and messing with suntar, MacGzip, or FTPing files to a Unix box.
And users can use this to unpack archives, without having to worry about
newlines and binary files, too.

Note that CPAN.pm will do the same basic unpacking for you, once done.  It
will also install and all that.  It won't test, and it certainly won't do
any building with MPW.  :)

So now I am going to work on finishing CPAN.pm and ExtUtils::MM_MacOS.
Once that's done, we are in the home stretch.  All that's left, that I can
think of offhand, is to get the binaries and ports in CPAN's indexes so
they can be installed from CPAN.pm.

Note: I wrote a short script and put it in my OSA Menu, and assigned it a
macro of command-4.  You can do it with the MacPerl Scripts folder, too.
Anyway, the script is just:

   #!perl -wMCPAN
   shell

That dumps me right into the CPAN shell that all you Unix folks are
probably familiar with.  Pretty nifty!

So, here are the two scripts.  Save them as droplets.  Eventually, once
these get tested (they are still beta), I will put them on my site and on
CPAN.  Maybe I'll also make one big package that will include and install
all the needed modules.

Please send me any bug reports or problems you have, and have fun.

#!perl -w
#-----------------------------------------------------------------#
#  untarzipme.plx
#  http://pudge.net/
#
#  Created:       Chris Nandor (pudge@pobox.com)       04 Jan 1999
#  Last Modified: Chris Nandor (pudge@pobox.com)       09 Jan 1999
#-----------------------------------------------------------------#
# This script unpacks tar.gz archives.  It converts all files
# that test true with -T to Mac newlines, and converts files
# that test true with -B and have the ending .bin from
# macbinary to regular Mac files.
#
# Edit $verbose and $switch variables to customize for verbosity
# and conversion behavior.
#-----------------------------------------------------------------#
use Archive::Tar;
use File::Basename;
use Mac::Conversions;
use strict;

my $verbose = 0;

my $conv = Mac::Conversions->new(Remove=>1);
my $tar = Archive::Tar->new($ARGV[0], 1) or die $!;
chdir(dirname($ARGV[0])) or die "Can't chdir: $!";

my $switch = MacPerl::Answer(
    'Convert all text and MacBinary files?', 'Yes', 'No');

my @files = $tar->list_files;

foreach my $file (@files) {
    my $dir = ':' . dirname(Archive::Tar::_munge_file($file));
    die "$dir already exists, will not overwrite\n"
        if -e $dir;
}

$tar->extract(@files);

foreach my $file (@files) {
    $file = ':' . Archive::Tar::_munge_file($file);
    chmod 0666, $file or die $!;
    next if ! $switch;
    if (-T $file) {
        local(*FILE, $/);
        open(FILE, "< $file\0") or die $!;
        my $text = <FILE>;
        $text =~ s/\015?\012/\n/g;
        close(FILE);
        open(FILE, "> $file\0") or die $!;
        print FILE $text;
        close(FILE);
        print "text      $file\n" if $verbose;
    } elsif (-B _ && $file =~ /\.bin$/) {
        $conv->demacbinary($file);
        print "macbinary $file\n" if $verbose;
    } elsif (-f _) {
        print "other bin $file\n" if $verbose;
    }
}

__END__


#!perl -w
#-----------------------------------------------------------------#
#  tarzipme.plx
#  http://pudge.net/
#
#  Created:       Chris Nandor (pudge@pobox.com)       04 Jan 1999
#  Last Modified: Chris Nandor (pudge@pobox.com)       09 Jan 1999
#-----------------------------------------------------------------#
# This script primarily for developers, to make distributions.
# Feel free to edit it to suit your needs: you might want to,
# for instance, make the macbinarizing non-interactive, and
# work only on certain file types.
#
# Edit $verbose and $switch variables to customize for verbosity
# and conversion behavior.
#-----------------------------------------------------------------#
use Archive::Tar;
use File::Basename;
use File::Copy;
use File::Find;
use Mac::Conversions;
use Mac::Dialogs;
use Mac::Events;
use Mac::Files;
use Mac::Fonts;
use Mac::Lists;
use Mac::MoreFiles;
use Mac::QuickDraw;
use Mac::Windows;

use strict;
use constant NO_CONVERSION  => 0;
use constant TEXT           => 1;
use constant MACBINARY      => 2;

my($verbose, $ans, $switch, $conv, %con, %style);
$verbose = 0;
$conv = new Mac::Conversions;

%style = (
    NO_CONVERSION, italic,
    TEXT         , normal,
    MACBINARY    , bold,
);
$ans = <<EOT;
Select a method for file conversion.  Select automatic conversion
(where -T means CR to LF conversion, and -B means MacBinarize),
pick a method for each file manually, or do no conversion.
EOT
$ans =~ s/\n/ /g;

do_it();

#-----------------------------------------------------------------#
sub do_it {
    my($dir, $tar, $file, @f, $mdir, $ndir, $tdir, $edir);

    $dir  = $ARGV[0] or die "Need directory name";
    $file = get_filename($dir);
    $ndir = basename($dir);
    $edir = "$ENV{TMPDIR}macperltar:";
    $tdir = "$edir$ndir";
    $mdir = dirname($tdir);
    $tar  = new Archive::Tar;

    die "Cannot continue: archive $file exists\n" if -e $file;
    create_dir($dir, $edir, $tdir);
    create_file($file);

    chdir($edir) or die "Can't chdir $edir: $!";

    $switch = MacPerl::Answer($ans, 'Automatic', 'Manual', 'None');
    do_dialog($tdir, $mdir) if $switch == 1;

    find(sub {
        my $f = $File::Find::name;
        return if ! -f $f || $f =~ /:Icon\n$/;
        (my $n = $f) =~ s/^$mdir//;
        $n = convert($f, $n) if $switch;
        push @f, $n;
    }, $tdir);

    $tar->add_files(@f);
    $tar->write($file, 1);
    remove_dir($tdir);
}
#-----------------------------------------------------------------#
sub guess {
    my $f = shift;
    my $guess = 0;
    if (-s $f && -T _) {
        $guess = TEXT;
    } elsif (-s _ && -B _) {
        $guess = MACBINARY;
    } elsif (-B _) {
        my $cat  = FSpGetCatInfo($f);
        $guess = MACBINARY if ($cat->ioFlRLgLen());
    }
    return $guess;
}
#-----------------------------------------------------------------#
sub convert {
    my($f, $n) = @_;
    if ($switch == 2) {
        my $guess = guess($f);
        if ($guess == TEXT) {
            return cr2lf($f, $n);
        } elsif ($guess == MACBINARY) {
            return bi2bin($f, $n);
        } else {
            return($f, $n);
        }
    } elsif ($switch == 1) {
        if ($con{$n} == TEXT) {
            return cr2lf($f, $n);
        } elsif ($con{$n} == MACBINARY) {
            return bi2bin($f, $n);
        } else {
            return($f, $n);
        }
    }
}
#-----------------------------------------------------------------#
sub bi2bin {
    my($f, $n, $t) = @_;
    undef $t;
    $conv->macbinary($f);
    $n .= '.bin';
    print "Macbinarized $n\n" if $verbose;
    return $n;
}
#-----------------------------------------------------------------#
sub cr2lf {
    local(*F, $/);
    my($f, $n, $t) = @_;
    open(F, "< $f\0") or die "Can't open $f: $!";
    $t = <F>;
    close(F);
    $t =~ s/\015\012?/\012/g if $t;
    open(F, "> $f\0") or die "Can't open $f: $!";
    print F $t;
    close(F);
    print "CRLF? to LF  $n\n" if $verbose;
    return $n;
}
#-----------------------------------------------------------------#
sub create_file {FSpCreate(shift, qw/Gzip Gzip/) or die $^E}
#-----------------------------------------------------------------#
sub create_dir {
    my($dir, $edir, $tdir) = @_;
    unless (-d $edir) {mkdir $edir, 0777 or die "Cannot create $edir: $!"}
    remove_dir($tdir) if -d $tdir;
    FSpDirectoryCopy($dir, $edir, 1)
        or die "Can't copy $dir to $edir: $^E";
}
#-----------------------------------------------------------------#
sub remove_dir {
    my $tdir = shift;
    finddepth(sub {
        my $n = $File::Find::name;
        if (-f $n) {
            unlink $n or die "Can't unlink $n: $!";
        } elsif (-d $n) {
            rmdir $n or die "Can't rmdir $n: $!";
        }
    }, $tdir);
}
#-----------------------------------------------------------------#
sub get_filename {
    my $name = shift;
    my($file, $path) = fileparse($name, '');
    my $tfile = length($file) < 24 ? "$file.tar.gz" :
        length($file) < 28 ? "$file.tgz" :
        substr($file, 0, 23) . "\xC9.tar.gz";
    return "$path$tfile";
}

#=================================================================#
# List stuff for manual selection #
#=================================================================#
sub do_dialog {
    my($tdir, $mdir) = @_;
    my @files;

    find(sub {
        my $f = $File::Find::name;
        return if ! -f $f || $f =~ /:Icon\n$/;
        (my $n = $f) =~ s/^$mdir//;
        push @files, $n;
        $con{$n} = [guess($f), 0];
    }, $tdir);

    my $win = MacWindow->new(
        Rect->new(100, 50, 550, 350), 'Files to tarzip',
        1, floatProc(), 1
    );
    $win->sethook(redraw => sub {});
    SetPort($win->window);
    TextFont(3);
    TextSize(9);
    my $list = $win->new_list(
        Rect->new(0, 0, 434, 300),
        Rect->new(0, 0, 1, scalar @files),
        Point->new(0, 0), \&myLDEF, 1, 1
    );

    $list->sethook(key=>sub{
        my($mod) = $Mac::Events::CurrentEvent->modifiers();
        if ($_[2] == ord('w') && (($mod & cmdKey()) == cmdKey())) {
            $win->dispose();
            return 1;
        }
        return;
    });

    for (my $c = 0; $c <= $#files; $c++) {
        $list->set(0, $c, $files[$c]);
    }

    while ($win->window()) {
        WaitNextEvent();
    }

    $win->dispose() if defined($win);

    END {
        $win->dispose() if defined($win);
    }

    foreach my $n (keys %con) {
        $con{$n} = $con{$n}->[0] % 3;
    }
}
#-----------------------------------------------------------------#
sub myLDEF {
    my($msg, $select, $rect, $cell, $data, $list) = @_;

    return unless $msg == lDrawMsg || $msg == lHiliteMsg;
    my($where) = AddPt($rect->topLeft, $list->indent);
    EraseRect $rect;
    TextFont(3+($cell->v & 1));
    TextSize(9);

    $con{$data}->[0]++ if ($select && ($con{$data}->[1]++ % 2));
    TextFace($style{ $con{$data}->[0] % 3 });
    LSetSelect(0, $cell, $list);

    MoveTo($where->h, $where->v);
    DrawString $data;
}
#-----------------------------------------------------------------#
sub check_value {
    my($win, $list, $x, $y) = @_;
    return if !$list->{'list'};
    $y = LGetSelect(1, Point->new(0,1), $list->{'list'});
    $x = $list->get($y) if $y;
    return if ref($x);
}
#-----------------------------------------------------------------#

__END__


--
Chris Nandor          mailto:pudge@pobox.com         http://pudge.net/
%PGPKey = ('B76E72AD', [1024, '0824090B CE73CA10  1FF77F13 8180B6B6'])


***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch
Prev by Date: Re: [MacPerl] Deleting files & interaction with AppleScript
Next by Date: Re: [MacPerl] Outputting to a printer (corrected)
Prev by thread: [MacPerl] 63% Recurring Partnership Program
Next by thread: Re: [MacPerl] (un)?tarzgipme
Navigation: Date Index | Thread Index | Search | Other lists at bumppo.net