use Config;
use File::Basename qw(basename dirname);
chdir(dirname($0));
($file = basename($0)) =~ s/\.PL$//;
$file =~ s/\.pl$//
        if ($Config{'osname'} eq 'VMS' or
            $Config{'osname'} eq 'OS2');  # "case-forgiving"

open YAMLPM, "< ../YAML.pm" or die $!;
$version = "unknown";
while (<YAMLPM>) {
    if (/\bVERSION\b/ && /(\d\.\d\d)/) {
        $version = "$1";
    }
}
close YAMLPM;

open OUT,">$file" or die "Can't create $file: $!";
chmod(0755, $file);
print "Extracting $file (with variable substitutions)\n";

print OUT <<"!GROK!THIS!", <<'!NO!SUBS!';
$Config{'startperl'} -w

\$VERSION = '$version';

!GROK!THIS!

=head1 NAME

yaml2outline - Convert a YAML outline into a standard one

=head1 USAGE

    yaml2outline outline.yaml > outline.txt

=head1 DESCRIPTION

This program converts a YAML file that conforms to a particular outline format, into a standard looking outline. It is really just a proof of concept, and not intended for any serious purpose.

Example:

    ---
    - Intro
    - Part 1:
       - Life
       - Love:
          - True Love:
             - Mexican Cuisine
             - Perl
          - Love at First Sight
       - Pursuit of YAML
    - Part 2:
       - Scissors:
          - Sewing
          - Hair
       - Paper
       - Rock:
          - Granite
          - Pixies
    - Part3:
       - Perl
       - Python
       - Ruby
    - Conclusion

yields:

    I) Intro

    II) Part 1
       A) Life
       B) Love
           1) True Love
               i) Mexican Cuisine
               ii) Perl
           2) Love at First Sight
       C) Pursuit of YAML

    III) Part 2
       A) Scissors
           1) Sewing
           2) Hair
       B) Paper
       C) Rock
           1) Granite
           2) Pixies

    IV) Part3
       A) Perl
       B) Python
       C) Ruby

    V) Conclusion

=head1 AUTHOR

Brian Ingerson <ingy@cpan.org>

=head1 COPYRIGHT

Copyright 2002, Brian Ingerson - All rights reserved

You may use this hack under the same terms as Perl itself.

=cut

use strict;
use YAML;

my ($yaml, $perl, $outline, $level, $symbol_level, $symbol_format, $lookup);

$yaml = join '', <>;
eval { $perl = Load($yaml); };
die "Error in YAML input:\n$@" if $@;

$level = -1;
$symbol_format = ['ROMAN', 'ALPHA', 'NUMERIC'];
$lookup = Load(join '', <DATA>);

walk_tree($perl);
print $outline;

sub walk_tree {
    my $node = shift;
    $level++;
    $symbol_level->[$level] = 0;
    my $ref = ref($node);
    die "Data structure is not valid for outline\n" 
      unless $ref eq 'ARRAY';
    for my $elem (@$node) {
	$ref = ref($elem) || 'STRING';
	if ($ref eq 'STRING') {
	    $outline .= (' ' x (4 * $level -1)) . 
	                symbol($level) . ') ' . $elem . "\n";
        }		
	elsif ($ref eq 'HASH') {
	    die "Data structure is not valid for outline\n" 
	      unless keys(%$elem) == 1;
	    my ($key) = keys(%$elem);
	    $outline .= (' ' x (4 * $level -1)) . 
	                symbol($level) . ') ' . $key . "\n";
	    walk_tree($elem->{$key});
        } 
	else {
	    die "Data structure is not valid for outline\n"; 
	}
	$outline .= "\n" unless $level;
    }
    $level--;
}

sub symbol {
    my $level = shift;
    my $format = $symbol_format->[$level % @$symbol_format];
    $format = lc($format) unless $level < @$symbol_format;
    return $lookup->{$format}[$symbol_level->[$level]++];
}

__DATA__
ROMAN: [I, II, III, IV, V, VI, VII, VIII, IX, X, XI, XII, XIII, XIV, XV, XVI]
ALPHA: [A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, w, x]
NUMERIC: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]
roman: [i, ii, iii, iv, v, vi, vii, viii, ix, x, xi, xii, xiii, xiv, xv, xvi]
alpha: [a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v, w, x]
numeric: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]
!NO!SUBS!
