home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / yaml2outline.bat < prev    next >
Encoding:
DOS Batch File  |  2003-09-17  |  3.7 KB  |  160 lines
  1. @rem = '--*-Perl-*--
  2. @echo off
  3. if "%OS%" == "Windows_NT" goto WinNT
  4. perl -x -S "%0" %1 %2 %3 %4 %5 %6 %7 %8 %9
  5. goto endofperl
  6. :WinNT
  7. perl -x -S %0 %*
  8. if NOT "%COMSPEC%" == "%SystemRoot%\system32\cmd.exe" goto endofperl
  9. if %errorlevel% == 9009 echo You do not have Perl in your PATH.
  10. if errorlevel 1 goto script_failed_so_exit_with_non_zero_val 2>nul
  11. goto endofperl
  12. @rem ';
  13. #!perl -w
  14. #line 15
  15.  
  16. $VERSION = '0.35';
  17.  
  18.  
  19. =head1 NAME
  20.  
  21. yaml2outline - Convert a YAML outline into a standard one
  22.  
  23. =head1 USAGE
  24.  
  25.     yaml2outline outline.yaml > outline.txt
  26.  
  27. =head1 DESCRIPTION
  28.  
  29. 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.
  30.  
  31. Example:
  32.  
  33.     ---
  34.     - Intro
  35.     - Part 1:
  36.        - Life
  37.        - Love:
  38.           - True Love:
  39.              - Mexican Cuisine
  40.              - Perl
  41.           - Love at First Sight
  42.        - Pursuit of YAML
  43.     - Part 2:
  44.        - Scissors:
  45.           - Sewing
  46.           - Hair
  47.        - Paper
  48.        - Rock:
  49.           - Granite
  50.           - Pixies
  51.     - Part3:
  52.        - Perl
  53.        - Python
  54.        - Ruby
  55.     - Conclusion
  56.  
  57. yields:
  58.  
  59.     I) Intro
  60.  
  61.     II) Part 1
  62.        A) Life
  63.        B) Love
  64.            1) True Love
  65.                i) Mexican Cuisine
  66.                ii) Perl
  67.            2) Love at First Sight
  68.        C) Pursuit of YAML
  69.  
  70.     III) Part 2
  71.        A) Scissors
  72.            1) Sewing
  73.            2) Hair
  74.        B) Paper
  75.        C) Rock
  76.            1) Granite
  77.            2) Pixies
  78.  
  79.     IV) Part3
  80.        A) Perl
  81.        B) Python
  82.        C) Ruby
  83.  
  84.     V) Conclusion
  85.  
  86. =head1 AUTHOR
  87.  
  88. Brian Ingerson <ingy@cpan.org>
  89.  
  90. =head1 COPYRIGHT
  91.  
  92. Copyright 2002, Brian Ingerson - All rights reserved
  93.  
  94. You may use this hack under the same terms as Perl itself.
  95.  
  96. =cut
  97.  
  98. use strict;
  99. use YAML;
  100.  
  101. my ($yaml, $perl, $outline, $level, $symbol_level, $symbol_format, $lookup);
  102.  
  103. $yaml = join '', <>;
  104. eval { $perl = Load($yaml); };
  105. die "Error in YAML input:\n$@" if $@;
  106.  
  107. $level = -1;
  108. $symbol_format = ['ROMAN', 'ALPHA', 'NUMERIC'];
  109. $lookup = Load(join '', <DATA>);
  110.  
  111. walk_tree($perl);
  112. print $outline;
  113.  
  114. sub walk_tree {
  115.     my $node = shift;
  116.     $level++;
  117.     $symbol_level->[$level] = 0;
  118.     my $ref = ref($node);
  119.     die "Data structure is not valid for outline\n" 
  120.       unless $ref eq 'ARRAY';
  121.     for my $elem (@$node) {
  122.     $ref = ref($elem) || 'STRING';
  123.     if ($ref eq 'STRING') {
  124.         $outline .= (' ' x (4 * $level -1)) . 
  125.                     symbol($level) . ') ' . $elem . "\n";
  126.         }        
  127.     elsif ($ref eq 'HASH') {
  128.         die "Data structure is not valid for outline\n" 
  129.           unless keys(%$elem) == 1;
  130.         my ($key) = keys(%$elem);
  131.         $outline .= (' ' x (4 * $level -1)) . 
  132.                     symbol($level) . ') ' . $key . "\n";
  133.         walk_tree($elem->{$key});
  134.         } 
  135.     else {
  136.         die "Data structure is not valid for outline\n"; 
  137.     }
  138.     $outline .= "\n" unless $level;
  139.     }
  140.     $level--;
  141. }
  142.  
  143. sub symbol {
  144.     my $level = shift;
  145.     my $format = $symbol_format->[$level % @$symbol_format];
  146.     $format = lc($format) unless $level < @$symbol_format;
  147.     return $lookup->{$format}[$symbol_level->[$level]++];
  148. }
  149.  
  150. __DATA__
  151. ROMAN: [I, II, III, IV, V, VI, VII, VIII, IX, X, XI, XII, XIII, XIV, XV, XVI]
  152. 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]
  153. NUMERIC: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]
  154. roman: [i, ii, iii, iv, v, vi, vii, viii, ix, x, xi, xii, xiii, xiv, xv, xvi]
  155. 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]
  156. numeric: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20]
  157.  
  158. __END__
  159. :endofperl
  160.