split-packages.pl

#!/usr/bin/perl
#
# split a transcript in transcripts per package
#
# If there are no package listings found, exits with error code 5
#
#
#
# IDEAS
# - server switch, use .bom files from server dirs

use strict;
my $transcript=$ARGV[0];
my $trname=$transcript;
$trname =~ s/.T$//i;

sub to_radmind
{
    $_[0] =~ s/\/\\/g;
    $_[0] =~ s/ /\b/g;
    $_[0] =~ s/ /\r/g;
    $_[0] =~ s/ /\n/g;
    return $_[0];
}

sub from_radmind
{
    $_[0] =~ s/\b/ /g;
    $_[0] =~ s/\r/ /g;
    $_[0] =~ s/\n/ /g;
    $_[0] =~ s/\\/\/g;
    return $_[0];
}

my @boms;
open (TR, $transcript) or die "Couldn't open transcript $transcript for reading: $!";
while(<TR>) {
    chomp;
    split;
    if ($_[0] eq 'f' and $_[1] =~ //Library/Receipts/.*.bom$/i) {
        push @boms, from_radmind($_[1]);
    }
}
exit 5 if $#boms == -1;

seek TR, 0, 0 or die;

my %knownfiles;
my %pkgnames;
foreach my $bom (@boms) {
    open(BOM, "lsbom "$bom"|");
    $bom =~ /^.*/([^/]+)/Contents//;
    my $pkgname=$1;
    $pkgnames{$pkgname}=1;
    $pkgname=",$pkgname,";
    while(<BOM>) {
        chomp;
        s/ .*$//;
        next if $_ eq ".";
        s/^.//;
        $knownfiles{to_radmind($_)}.=$pkgname;
    }
    close BOM;
}

use IO::Handle;
my %pkgfiles;
foreach my $pkg (keys %pkgnames) {
    $pkgfiles{$pkg} = IO::Handle->new();
    open ($pkgfiles{$pkg}, ">$trname-$pkg.T") or die "Couldn't open $trname-$pkg.T for writing: $!";
}
open(DELS,">$trname-deletes.T") or die "Couldn't open deletes file for writing: $!";
open(ORPHANS,">$trname-orphans.T") or die "Couldn't open orphans file for writing: $!";

my $owners;
my $line;
while(<TR>) {
    chomp;
    split;
    $line=$_." ";
    if ( $_[0] eq "-") {
        print DELS $line;
    } elsif ( $owners = $knownfiles{$_[1]} ) {
        foreach my $pkg (keys %pkgfiles) {
            if ($owners =~ /,$pkg,/i) {
                my $fh = $pkgfiles{$pkg};
                print $fh $line or warn "Couldn't write to transcript $pkg: $!";
            }
        }
    } elsif ( $_[1] =~ /^/Library/Receipts/([^/]+)/ ) {
        my $pkg = $1;
        if (exists($pkgfiles{$pkg})) {
            my $fh = $pkgfiles{$pkg};
            print $fh $line or warn "Couldn't write to transcript $pkg: $!";
        } else {
            print ORPHANS $line;
        }
    } else {
        print ORPHANS $line;
    }
}
print STDERR "All done, please look at $trname-*.T ";