#! /usr/bin/perl -w
#
# A self-contained bdecoder, cut'n'pasted together from various sources
# (largely CPAN) on the web. Use at your own risk. --cpk
#
use strict;
use warnings;
use bytes;

my %Printable = ( ( map { chr($_), unpack('H2', chr($_)) } (0..255) ),
		  "\\"=>'\\', "\r"=>'r', "\n"=>'n', "\t"=>'t', "\""=>'"' );

sub printable ($) {
  local $_ = ( defined $_[0] ? $_[0] : '' );
  s/([\r\n\t\"\\\x00-\x1f\x7F-\xFF])/\\$Printable{$1}/sg;
  return $_;
}

sub bdecode {
	my $string = shift;
	my @chunks = split(//, $string);
	my $root = _dechunk(\@chunks);
	return $root;
}

sub _dechunk {
	my $chunks = shift;

	my $item = shift(@{$chunks});
	if($item eq 'd') {
		$item = shift(@{$chunks});
		my %hash;
		while($item ne 'e') {
			unshift(@{$chunks}, $item);
			my $key = _dechunk($chunks);
			$hash{$key} = _dechunk($chunks);
			$item = shift(@{$chunks});
		}
		return \%hash;
	}
	if($item eq 'l') {
		$item = shift(@{$chunks});
		my @list;
		while($item ne 'e') {
			unshift(@{$chunks}, $item);
			push(@list, _dechunk($chunks));
			$item = shift(@{$chunks});
		}
		return \@list;
	}
	if($item eq 'i') {
		my $num;
		$item = shift(@{$chunks});
		while($item ne 'e') {
			$num .= $item;
			$item = shift(@{$chunks});
		}
		return $num;
	}
	if($item =~ /\d/) {
		my $num;
		while($item =~ /\d/) {
			$num .= $item;
			$item = shift(@{$chunks});
		}
		my $line = '';
		for(1 .. $num) {
			$line .= shift(@{$chunks});
		}
		return $line;
	}
	return $chunks;
}

sub print_array {
    my ($data, $indent) = @_;
    my $i = 0;
    print ' ' x $indent;
    print "a:\n";
    
    foreach my $el (@$data) {
	
	print " " x ($indent + 2);
	print "$i:\n";

	if (ref($el) eq 'ARRAY') {
	    print_array($el, $indent + 4);
	} elsif (ref($el) eq 'HASH') {
	    print_dict($el, $indent + 4);
	} else {
	    print_scalar($el, $indent + 4);
	}	
	
	$i += 1;
    }
}

sub print_dict {
    my ($data, $indent) = @_;
    my ($key, $el);
    print ' ' x $indent;
    print "d:\n";

    while ( ($key, $el) = each(%$data)) {

	$key = printable($key);
	print " " x ($indent + 2);
	print "$key:\n";
	
	if (ref($el) eq 'ARRAY') {
	    print_array($el, $indent + 4);
	} elsif (ref($el) eq 'HASH') {
	    print_dict($el, $indent + 4);
	} else {
	    print_scalar($el, $indent + 4);
	}	
    }
}

sub print_scalar {
    my ($data, $indent) = @_;
    my $cropped = "";
    my $esc_data = printable($data);

    if (length($esc_data) > 500) {
	$esc_data = substr($esc_data, 0, 500);
	$cropped = "[...]";
    }

    print ' ' x $indent;
    print "s: $esc_data$cropped\n";
}

sub read_file
{
    my ($file) = @_;

    local($/) = wantarray ? $/ : undef;
    local(*F);
    my $r;
    my (@r);

    open(F, "<$file") || return undef;
    @r = <F>;
    close(F) || return undef;
    
    return $r[0] unless wantarray;
    return @r;
}

# Take each command line argument as a filename,
# read it, and try to dump out bdecoded version.
#
foreach my $arg (@ARGV) {

    my $raw = read_file($arg);

    unless ($raw) {
	print "Could not open $arg, skipping.\n";
	next;
    }
    
    my $data = bdecode($raw);

    unless ($data) {
	print "Could not decode data in $arg\n";
	next;
    }
    
    if (ref($data) eq 'ARRAY') {
	print_array($data, 1);
    } elsif (ref($data) eq 'HASH') {
	print_dict($data, 1);
    } else {
	print_scalar($data, 1);
    }
}