summaryrefslogtreecommitdiffstats
path: root/read_object.pl
blob: f4ee248769d6b1d4a1dd5ad26ac2869620444bb5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
#!/usr/bin/env perl

use Compress::Zlib;
use Digest::SHA qw(sha1_hex);
use File::Basename;
use Data::Dumper;

use strict;
use warnings;

my @filedata = <>;
my ($signature, $type, $size, $data) = read_object(join('', @filedata));
my $out = format_object($type, $data);

print "signature: $signature\ntype: $type\nsize: $size\n"
    . ("-" x 40) . "\n$out\n";

sub read_object {
    my ($zlib_data) = @_;

    my $raw_data = uncompress($zlib_data)
        || die "Couldn't uncompress zlib data.";
    my $sig = sha1_hex($raw_data);
    $raw_data =~ /(.*?) (.*?)\0(.*)/s || die "Invalid object format.";

    my ($type, $size, $data) = ($1, $2, $3);
    warn "Size mismatch: got $size, but was actually " . length($data)
        unless length($data) == $size;

    ($sig, $type, $size, $data);
}

sub format_object {
    my ($type, $obj) = @_;

    if ($type eq 'commit') {
        $obj;
    } elsif ($type eq 'tag') {
        $obj;
    } elsif ($type eq 'tree') {
        format_tree($obj)
    } elsif ($type eq 'blob') {
        hexdump($obj);
    } else {
        warn "Unknown object type, showing hex representation: $type.\n";
        hexdump($obj);
    }
}

sub format_tree {
    my ($str) = @_;

    my @tree = split /\0(.{20})/, $str;
    my @rc = ();
    while (@tree) {
        my ($info, $id) = (shift @tree, shift @tree);
        $info =~ /^([^ ]*) (.*)/;
        my ($mode, $name) = ($1, $2);
        my @bytes = unpack('C*', $id);
        my $sig = join '', map { sprintf('%02x', $_) } @bytes;

        push @rc, "$mode $sig\t$name";
    }
    join "\n", @rc;
}

sub hexdump {
    my ($str) = @_;

    my ($i, $len, @chunks) = (0, length($str), ());
    while ($i < $len) {
        my $rem = $len - $i;
        $rem = 16 unless $rem < 16;
        push @chunks, substr($str, $i, $rem);
        $i += $rem;
    }

    join "\n", map {
        my @chars = unpack('C*', $_);
        my @hex = map { sprintf('%02x ', $_) } @chars;
        my @filtered = map { ($_ >= 040 && $_ <= 0176) ? pack('C', $_) : '.' } @chars;
        my $spaces = (16 - @hex) * 3 + 4;
        join('', @hex) . (' ' x $spaces) . join('', @filtered)
    } @chunks;
}

1;