code_perl/Maasha/Gwiki.pm

   1 package Maasha::Gwiki;
   2
   3 # Copyright (C) 2008 Martin A. Hansen.
   4
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # http://www.gnu.org/copyleft/gpl.html
  20
  21
  22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  23
  24
  25 # Routines for manipulation of Google's wiki format
  26
  27
  28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  29
  30
  31 use strict;
  32 use Data::Dumper;
  33 use Term::ANSIColor;
  34 use Maasha::Common;
  35 use vars qw ( @ISA @EXPORT );
  36
  37 @ISA = qw( Exporter );
  38
  39
  40 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  41
  42
  43 sub gwiki2ascii
  44 {
  45     # Martin A. Hansen, June 2008.
  46
  47     # Convert Google style wiki as ASCII text lines.
  48
  49     my ( $wiki,  # wiki data structure
  50        ) = @_;
  51
  52     # Returns a list of lines.
  53
  54     my ( $block, $triple, $line, @lines, $i );
  55
  56     foreach $block ( @{ $wiki } )
  57     {
  58         if ( $block->[ 0 ]->{ 'FORMAT' } eq "heading" )
  59         {
  60             push @lines, text_underline( text_bold( "\n$block->[ 0 ]->{ 'TEXT' }" ) );
  61         }
  62         elsif ( $block->[ 0 ]->{ 'FORMAT' } eq "subheading" )
  63         {
  64             push @lines, text_bold( "$block->[ 0 ]->{ 'TEXT' }" );
  65         }
  66         elsif ( $block->[ 0 ]->{ 'FORMAT' } eq "level_3" )
  67         {
  68             push @lines, "$block->[ 0 ]->{ 'TEXT' }";
  69         }
  70         elsif ( $block->[ 0 ]->{ 'FORMAT' } eq "verbatim" )
  71         {
  72             map { push @lines, "   $_->{ 'TEXT' }" } @{ $block };
  73         }
  74         elsif ( $block->[ 0 ]->{ 'FORMAT' } eq "itemize" )
  75         {
  76             for ( $i = 0; $i < @{ $block }; $i++ ) {
  77                 push @lines, "   * $block->[ $i ]->{ 'TEXT' }";
  78             }
  79         }
  80         elsif ( $block->[ 0 ]->{ 'FORMAT' } eq "enumerate" )
  81         {
  82             for ( $i = 0; $i < @{ $block }; $i++ ) {
  83                 push @lines, "   " . ( $i + 1 ) . ". $block->[ $i ]->{ 'TEXT' }";
  84             }
  85         }
  86         elsif ( $block->[ 0 ]->{ 'FORMAT' } eq "paragraph" )
  87         {
  88             foreach $triple ( @{ $block } )
  89             {
  90                 $line = $triple->{ 'TEXT' };
  91
  92                 $line =~ s/!(\w)/$1/g;
  93                 $line =~ s/^\s*//;
  94                 $line =~ s/\s*$//;
  95                 $line =~ s/\s+/ /g;
  96                 $line =~ tr/`//d;
  97                 $line =~ s/\[([^\]]+?)\]/&text_underline($1)/ge;
  98                 $line =~ s/\*(\w+)\*/&text_bold($1)/ge           if $line =~ /(^| )\*\w+\*( |$)/;
  99                 $line =~ s/_(\w+)_/&text_underline($1)/ge        if $line =~ /(^| )_\w+_( |$)/;
 100
 101                 push @lines, $_ foreach &Maasha::Common::wrap_line( $line, 80 );
 102             }
 103         }
 104         elsif ( $block->[ 0 ]->{ 'FORMAT' } eq "whitespace" )
 105         {
 106             push @lines, "";
 107         }
 108     }
 109
 110     return wantarray ? @lines : \@lines;
 111 }
 112
 113
 114 sub gwiki_read
 115 {
 116     # Martin A. Hansen, June 2008.
 117
 118     # Parses a subset of features from Googles wiki format
 119     # into a data structure. The structure consists of a
 120     # list of blocks. Each block consists of one or more lines,
 121     # represented as triples with the line text, section, and format option.
 122
 123     # http://code.google.com/p/support/wiki/WikiSyntax
 124
 125     my ( $file,   # file to parse
 126        ) = @_;
 127
 128     # Returns data structure.
 129
 130     my ( $fh, @lines, $i, $c, $section, $paragraph, @block, @output );
 131
 132     $fh = &Maasha::Common::read_open( $file );
 133
 134     @lines = <$fh>;
 135
 136     chomp @lines;
 137
 138     close $fh;
 139
 140     $i = 0;
 141     $c = 0;
 142
 143     while ( $i < @lines )
 144     {
 145         undef @block;
 146
 147         if ( $lines[ $i ] =~ /^===\s*(.+)\s*===$/ )
 148         {
 149             $section = $1;
 150
 151             push @block, {
 152                 TEXT    => $section,
 153                 SECTION => $section,
 154                 FORMAT  => "level_3",
 155             };
 156         }
 157         elsif ( $lines[ $i ] =~ /^==\s*(.+)\s*==$/ )
 158         {
 159             $section = $1;
 160
 161             push @block, {
 162                 TEXT    => $section,
 163                 SECTION => $section,
 164                 FORMAT  => "subheading",
 165             };
 166         }
 167         elsif ( $lines[ $i ] =~ /^=\s*(.+)\s*=$/ )
 168         {
 169             $section = $1;
 170
 171             push @block, {
 172                 TEXT    => $section,
 173                 SECTION => $section,
 174                 FORMAT  => "heading",
 175             };
 176         }
 177         elsif ( $lines[ $i ] =~ /^\{\{\{$/ )
 178         {
 179             $c = $i + 1;
 180
 181             while ( $lines[ $c ] !~ /^\}\}\}$/ )
 182             {
 183                 push @block, {
 184                     TEXT    => $lines[ $c ],
 185                     SECTION => $section,
 186                     FORMAT  => "verbatim",
 187                 };
 188
 189                 $c++;
 190             }
 191
 192             $c++;
 193         }
 194         elsif ( $lines[ $i ] =~ /^\s{1,}\*\s*.+/ )
 195         {
 196             $c = $i;
 197
 198             while ( $lines[ $c ] =~ /^\s{1,}\*\s*(.+)/ )
 199             {
 200                 push @block, {
 201                     TEXT    => $1,
 202                     SECTION => $section,
 203                     FORMAT  => "itemize"
 204                 };
 205
 206                 $c++;
 207             }
 208         }
 209         elsif ( $lines[ $i ] =~ /^\s{1,}#\s*.+/ )
 210         {
 211             $c = $i;
 212
 213             while ( $lines[ $c ] =~ /^\s{1,}#\s*(.+)/ )
 214             {
 215                 push @block, {
 216                     TEXT    => $1,
 217                     SECTION => $section,
 218                     FORMAT  => "enumerate"
 219                 };
 220
 221                 $c++;
 222             }
 223         }
 224         elsif ( $lines[ $i ] !~ /^\s*$/ )
 225         {
 226             undef $paragraph;
 227
 228             $c = $i;
 229
 230             while ( $lines[ $c ] !~ /^\s*$/ )
 231             {
 232                 $paragraph .= " $lines[ $c ]";
 233
 234                 $c++;
 235             }
 236
 237             push @block, {
 238                 TEXT    => $paragraph,
 239                 SECTION => $section,
 240                 FORMAT  => "paragraph",
 241             };
 242         }
 243         elsif ( $lines[ $i ] =~ /^\s*$/ )
 244         {
 245             push @block, {
 246                 TEXT    => "",
 247                 SECTION => $section,
 248                 FORMAT  => "whitespace",
 249             };
 250         }
 251
 252         push @output, [ @block ], if @block;
 253
 254         if ( $c > $i ) {
 255             $i = $c;
 256         } else {
 257             $i++;
 258         }
 259     }
 260
 261     return wantarray ? @output : \@output;
 262 }
 263
 264
 265 sub text_bold
 266 {
 267     my ( $txt,
 268        ) = @_;
 269
 270     return colored ( $txt, "bold" );
 271 }
 272
 273
 274 sub text_underline
 275 {
 276     my ( $txt,
 277        ) = @_;
 278
 279     return colored ( $txt, "underline" );
 280 }
 281
 282
 283 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 284