#!/usr/bin/perl -w
# cabsplit splits a cabinet into one cabinet per folder.
# Mostly useful for debugging.
use strict;

die "Usage: $0 <cab file(s)>\n" unless @ARGV;
for my $file (@ARGV) {
    if (open FH, "<$file") {
        my $err = split_cabinet($file);
        print "$file: $err\n" if $err;
        close FH;
    }
    else {
        warn "$file: $!\n";
    }
}

sub split_cabinet {
    my $fname = $_[0];
    my $buf;
    
    read FH, $buf, 36;
    my @hdr = unpack 'V6C2v5', $buf;
    return "not a cab file" unless $hdr[0] == 0x4643534D;
    my $num_folders = $hdr[8];
    my $num_files   = $hdr[9];

    my ($folder_resv, $block_resv) = (0, 0);
    if ($hdr[10] & 0x0004) {
        read FH, $buf, 4;
        my @hdr_resv = unpack 'vCC', $buf;
        seek FH, $hdr_resv[0], 1;
        $folder_resv = $hdr_resv[1];
        $block_resv  = $hdr_resv[2];
    }
    read_string(), read_string() if $hdr[10] & 0x0001;
    read_string(), read_string() if $hdr[10] & 0x0002;

    # read folders
    my @folders = map { read FH, $_, 8; seek FH, $folder_resv, 1; $_ } 1 .. $num_folders;

    # read files
    my @files;
    for (1 .. $num_files) {
        read FH, $buf, 16;
        my @file = unpack 'V2v4', $buf;
        my $fname = read_string();
        my $folder = $file[2];
        if ($folder == 0xFFFD || $folder == 0xFFFF) { $folder = 0 }
        elsif ($folder == 0xFFFE) { $folder = $num_folders-1 };
        $file[2] = 0;
        push @{$files[$folder]}, pack 'V2v4Z*', @file, $fname;
    }

    for my $i (0 .. $#folders) {
        my ($offset, $cnt) = unpack 'Vv', $folders[$i];
        seek FH, $offset, 0;
        my $blocks = join '', map {
            read FH, $buf, 8;
            my $csize = (unpack 'Vvv', $buf)[1];
            seek FH, $block_resv, 1;
            read FH, $_, $csize;
            $buf . $_;
        } 1 .. $cnt;

        my $files = join '', @{$files[$i]};

        $hdr[2] = 36 + 8 + length($files) + length($blocks); # cab length
        $hdr[4] = 36 + 8; # files offset
        $hdr[8] = 1; # number of folders
        $hdr[9] = @{$files[$i]}; # number of files
        $hdr[10] = 0; # flags
        substr($folders[$i], 0, 4, pack('V', 36 + 8 + length($files)));

        my $outname = sprintf "%s.%03d", $fname, $i+1;
        return "can't create $outname: $!" unless open OUT, ">$outname";
        print OUT pack('V6C2v5', @hdr) . $folders[$i] . $files . $blocks;
        close OUT;
    }

    return 0;
}

sub read_string {
    my $pos = tell FH;
    my $buf; read FH, $buf, 256;
    my ($string) = unpack 'Z*', $buf;
    seek FH, $pos + length($string) + 1, 0;
    return $string;
}
