Contributions/robodoc2pod.pl

   1 #!/usr/bin/perl
   2 ###################################################
   3 # robodoc 2 pod converter
   4 ###################################################
   5 #****h* robodoc2pod
   6 # NAME
   7 # Robodoc 2 Pod
   8 #
   9 # FUNCTION
  10 # Generate POD documentation from ROBODoc to allow
  11 # use of perldoc with your Robodoc'ed code.
  12 #
  13 # HISTORY
  14 # * V 0.2.1 of 06/03/14         corrected the regexps
  15 # * V 0.2.0 of 06/03/13         rewritten with intermediate representation
  16 # * V 0.1.0 of 06/03/10         first version
  17 #
  18 # BUGS
  19 # nothing known right now.
  20 #
  21 # TODO
  22 # * refactor cleanly
  23 # * manage locales
  24 # * manage nested lists
  25 # * indent EXAMPLE with
  26 #
  27 # LICENSE
  28 # This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
  29 # AUTHOR
  30 # Emmanuel Florac ( wazoox @ free . fr )
  31 # COPYRIGHT
  32 # (c) 2006 Intellique (www.intellique.com)
  33 #***
  34 # always use strict et warnings.
  35 use strict;
  36 use warnings;
  37
  38 use Data::Dumper;
  39
  40 #########################
  41 # functions
  42 #########################
  43
  44 sub usage {
  45     return "usage  : $0 <source file> [ >> <pod file> ]";
  46 }
  47
  48 #########################
  49 # main
  50 #########################
  51
  52 # must provide a file name to work with
  53 my $file = shift or die usage();
  54 open my $fh, $file or die "can't open file : $file";
  55
  56 # robodoc start and end tags (marks robodoc blocks)
  57 my $rbd_starttag = qr(^\*\*\*\*[\w\*]\*);
  58 my $rbdheadtype  = qr(^\*\*\*\*([\w\*])\*);
  59 my $rbd_endtag   = qr(^\*\*\*);
  60
  61 # robodoc general tags
  62 my @rbdtags = (
  63     'NAME',          'COPYRIGHT',      'SYNOPSIS',    'USAGE',
  64     'FUNCTION',      'DESCRIPTION',    'PURPOSE',     'AUTHOR',
  65     'CREATION DATE', 'MODIFICATION',   'HISTORY',     'INPUTS',
  66     'ARGUMENTS',     'OPTIONS',        'PARAMETERS',  'SWITCHES',
  67     'OUTPUT',        'SIDE EFFECTS',   'RESULT',      'RETURN VALUE',
  68     'EXAMPLE',       'NOTES',          'DIAGNOSTICS', 'WARNINGS',
  69     'ERRORS',        'BUGS',           'TODO',        'IDEAS',
  70     'PORTABILITY',   'SEE ALSO',       'METHODS',     'NEW METHODS',
  71     'ATTRIBUTES',    'NEW ATTRIBUTES', 'TAGS',        'COMMANDS',
  72     'DERIVED FROM',  'DERIVED BY',     'USES',        'CHILDREN',
  73     'USED BY',       'PARENTS',        'SOURCE',           'LICENSE',
  74 );
  75
  76 my %rbdheaders = (
  77     c   => 'Class',
  78     d   => 'Constant',
  79     f   => 'Fonction',
  80     h   => 'Module',
  81     m   => 'Méthod',
  82     s   => 'Structure',
  83     t   => 'Type',
  84     u   => 'Unit Test',
  85     v   => 'Variable',
  86     '*' => '',
  87 );
  88
  89 # to check for headers tags
  90 my $tagmatch = join '|', @rbdtags;
  91 $tagmatch = qr(^($tagmatch));
  92
  93 # to store the robodoc
  94 my @robodoc;
  95
  96 # flag and titles
  97 my $inrobodoc  = 0;
  98 my $rbdtagname = '';
  99
 100 # read the file
 101 while (<$fh>) {
 102
 103     # remove leading # if any
 104     s/^\s*# *//;
 105     chomp;
 106
 107     $inrobodoc = 0 if m/$rbd_endtag/;
 108
 109     if ($inrobodoc) {
 110         push @{ $robodoc[$#robodoc]{$rbdtagname} }, $_;
 111     }
 112
 113     if (m/$rbd_starttag/) {
 114         $inrobodoc = 1;
 115         my ($headertype) = (m/$rbdheadtype/);
 116         ($rbdtagname) = (m/$rbd_starttag(.*)/);
 117         chomp $rbdtagname;
 118         if ($rbdtagname) {
 119             $rbdtagname = $rbdheaders{$headertype} . $rbdtagname;
 120             push @robodoc, { $rbdtagname => [] };
 121         }
 122     }
 123 }
 124
 125 close $fh;
 126
 127 # now convert robodoc to pod
 128 my @pod;
 129 my $items   = 0;
 130 my $podhead = 1;
 131
 132 foreach (@robodoc) {
 133     my ( $k, $v ) = each %$_;
 134     my $currhead = $podhead;
 135     push @pod, '', "=head$currhead $k", '';
 136     $currhead++;
 137
 138     foreach my $line (@$v) {
 139                 # insert head if this is a managed tag
 140         if ( $line =~ m/$tagmatch/ ) {
 141             push @pod, ( '', "=head$currhead $line", '' );
 142                 # insert bulleted lists
 143         } elsif ( my ($elem) = ( $line =~ m/^\*\s+(.*)/ ) ) {
 144             if ( $items == 0 ) {
 145                 $items++;
 146                 push @pod, "=over";
 147             }
 148             push @pod, ( '', '=item *', '', $elem );
 149                 # end bulleted list
 150         } elsif ( $items > 0 ) {
 151             $items = 0;
 152             push @pod, ('', '=back', '');
 153             push @pod, $line;
 154                 # raw insert
 155         } else {
 156             push @pod, $line;
 157         }
 158     }
 159 }
 160
 161 print join( "\n", @pod ) . "\n";
 162