File Coverage

blib/lib/Markdown/Foswiki.pm
Criterion Covered Total %
statement 12 155 7.7
branch 0 40 0.0
condition 0 11 0.0
subroutine 4 11 36.3
pod 5 7 71.4
total 21 224 9.3


line stmt bran cond sub pod time code
1             package Markdown::Foswiki;
2 1     1   5 use strict;
  1         2  
  1         35  
3 1     1   4 use warnings;
  1         2  
  1         191  
4             our $VERSION = '0.04';
5              
6 1     1   32 use 5.010;
  1         2  
  1         11433  
7              
8             sub new {
9 0     0 1   my $self = {};
10 0           bless $self;
11 0           $self->initialize();
12 0           return $self;
13             }
14              
15             ###
16             # Configure SET
17             # $converter->setConfig ( 'Attr' => 'Value' );
18             # $converter->setConfig ( 'IncLang' => 'none' );
19             #
20             #
21             #
22             sub setConfig {
23 0     0 1   my $self = shift;
24              
25 0 0         $#_ % 2 or die("A pair of arguments is not correct");
26            
27 0           my %args = @_;
28              
29             exists $self->{config}->{$_} ? $self->{config}->{$_} = $args{$_} :
30 0 0         die ("\"$_\" is not attribute") for keys %args;
31              
32             # say "$_ -> $self->{config}->{$_}" for keys $self->{config};
33            
34             }
35              
36             ###
37             # Load Data
38             # $converter->getData( $filename );
39             sub getData {
40 0     0 1   my ($self,$filename) = @_;
41 0           my @lines;
42              
43 0 0         open my $fh, "<", $filename or die "open error:$!";
44 0           push @lines, $_ for <$fh>;
45 0           close $fh;
46              
47 0           return @lines;
48             }
49              
50              
51             ###
52             # config , rules initializing
53             sub initialize {
54 0     0 0   my $self = shift;
55              
56             #Defulat Config
57 0           my $head_text = '%META:TOPICINFO{author="Markdown::Foswiki" date="'.time().'" format="1.1" version="1"}%';
58            
59 0           my $head_contents = "%TOC%\n";
60              
61 0           my $footer_text = '';
62              
63 0           my $foot_contents = '';
64            
65 0           my %config;
66 0           $config{header_text} = $head_text;
67 0           $config{head_contents} = $head_contents;
68 0           $config{footer_text} = $footer_text;
69 0           $config{foot_contents} = $foot_contents;
70 0           $config{InterLinkBase} = '';
71 0           $config{IncLang} = 'plain'; # default : plain ,options: none , c ,c++,...
72              
73 0           $self->{config} = {%config};
74             #Config End
75              
76              
77 0           my %rules ;
78 0           $rules{Definition} = qr /^(.*?)
(.*?)$/;
79             # Definition List Word
Word -> $ Word:Word || Word
Word
80 0           $rules{TableStart} = qr /^$/; $/; -> | *Word* |
81             # table tag open -> new line
82 0           $rules{TRO} = qr /^
83             # tr tag open -> new line
84 0           $rules{TRC} = qr /^<\/tr>$/;
85             # tr tag close -> ignore
86 0           $rules{TDO} = qr /^(.*?)<\/t(d|h)>$/;
87             # td or td tag Word -> | Word | // Word
88 0           $rules{TableEnd} = qr /^<\/table>$/;
89             # Table close -> new line
90 0           $rules{Row} = qr /^----$/;
91             # Row ---- -> ---
92 0           $rules{Heading} = qr /^(#+?)\s(.*?)#*$/;
93             # Heading #.. Word -> ---+.. Word
94 0           $rules{Bold} = qr /^\*(\*.*?\*)\*$/;
95             # Bold **Word** -> *Word*
96 0           $rules{SaveLinkList} = qr /^\s\s\[(\d+)\]:\s(.*?)(\s|$)/;
97             # MD link list -> make array
98 0           $rules{ShellDetecting} = qr /^\$\s(.*)$/;
99             # shell Start : $ Words -> $ Words
100 0           $rules{CodeDetecting} = qr /(;|\}$|\{$)/;
101             # CODE detecting -> %CODE{ lang="sql" }%\n codes %ENDCODE% || codes
102 0           $rules{ContentsTable} = qr /^\*\*(.*?)\*\*(.+\[.*\]\[\d+\]){2,2}/;
103             # ContentsTable :Structure to begin with a Bold Word and link enumulation
104 0           $rules{MimeTableNewLine} = qr /^\---([\+\-]*\+[\+\-]*)\---$/;
105             # -------+------- -> ''
106 0           $rules{MimeTableCap} = qr /^(\s*.+?\s+\|\s+.+?\s*)$/;
107             # Word | Word -> | Word | Word |
108 0           $rules{List} = qr /^(\s*)\*(.*)$/;
109             # List ^ * Word level1 | ^ * Word level2...
110 0           $rules{FunctionDetecting} = qr /^[a-zA-Z\_][\w\_]*?\s?\(.*?\).*(\.)/;
111             # function
112 0           $rules{indent} = qr /^\t+(.*?)$/;
113             # begin \t word
114              
115 0           $self->{rules} = {%rules};
116             }
117              
118              
119             sub process {
120 0     0 1   my $self = shift;
121 0           my @data = @_;
122              
123 0           my ($result, @link_list, @lines, $LP);
124 0           $LP = 0;
125             #result
126             #link_list
127             #lines
128             #LP : LinePointer
129              
130              
131 0           for ( @data ) {
132              
133              
134             # remove newline character
135             # adding newline character to end line when completes to line convert
136 0           chomp();
137              
138             # filtering invalid character
139 0           $_ = word_replace($_);
140            
141 0           my $converted;
142            
143 0           given ( $_ ) {
144 0           when ( /$self->{rules}->{Definition}/ ) {
145 0 0         if ( length($1) < 25 ) {
146 0           $converted = " \$ $1: $2\n";
147             } else {
148 0           $converted = "$_\n";
149             }
150             }
151              
152 0           when ( /$self->{rules}->{TableStart}/ ) {
153 0           $converted = "";
154             }
155 0           when ( /$self->{rules}->{TRO}/ ) {
156 0           $converted = "\n";
157             }
158 0           when ( /$self->{rules}->{TRC}/ ) {
159             }
160 0           when ( /$self->{rules}->{TDO}/ ) {
161 0           my $th_or_td = $1;
162 0           my $matched = $2;
163 0 0         if ( $lines[$LP-1] =~ /\|$/ ) {
164 0 0         $converted = ($th_or_td eq 'd')? " $matched |" : " *$matched* |";
165             }else
166             {
167 0 0         $converted = ($th_or_td eq 'd')? "| $matched |":"| *$matched* |";
168             }
169             }
170 0           when ( /$self->{rules}->{TableEnd}/ ) {
171 0           $converted = "\n";
172             }
173 0           when ( /$self->{rules}->{Row}/ ) {
174 0           $converted = "---\n";
175             }
176 0           when ( /$self->{rules}->{Heading}/ ) {
177 0           $converted = sprintf("---".("+"x length($1))." $2\n");
178             }
179 0           when ( /$self->{rules}->{Bold}/ ) {
180 0           $converted = $1."\n";
181             }
182 0           when ( /$self->{rules}->{SaveLinkList}/ ) {
183 0           $link_list[$1] = $2;
184             }
185 0           when ( /$self->{rules}->{ShellDetecting}/ ) {
186 0           $converted = "\n\n\n\$ $1\n\n";
187             }
188 0           when ( /$self->{rules}->{CodeDetecting}/ ) {
189 0 0         continue if $self->{config}->{IncLang} eq 'none';
190              
191 0           $converted = $_."\n";
192            
193 0           for (my $SLP = $LP ; $SLP > -1 ; $SLP--) {
194 0 0 0       if ( defined($lines[$SLP]) and ( $lines[$SLP] eq "\n" or $lines[$SLP] =~ /<\/verbatim>|\%ENDCODE\%/ ) ) {
      0        
195 0 0         $lines [$SLP] .= $self->{config}->{IncLang} eq 'plain' ?
196             "\n\n":
197             "\n\%CODE{ lang=".'"'.$self->{config}->{IncLang}.'"'." }\%\n";
198 0 0         $converted = $self->{config}->{IncLang} eq 'plain' ?
199             $_."\n\n" :
200             $_."\n\%ENDCODE\%\n";
201 0           last;
202             }
203             }
204             }
205 0           when ( /$self->{rules}->{ContentsTable}/ ) {
206 0           my $numbers = '[\d]';
207 0           my @listers = /((?:.*?\*\*.*?\*\*)|(?:.*?\[.*?\]\[$numbers+\]))/g;
208              
209 0           for ( @listers ) {
210 0           my $listDepth = 0;
211            
212 0 0         if ( /^((?:$numbers+(?:\.)(?:$numbers+(?:\.| ))*)|(?:$numbers+\s))/ ) {
213 0           $listDepth++ for split /$numbers+/,$1;
214             }
215              
216 0 0         $listDepth -= $listDepth > 0? 1:0;
217              
218 0 0         if ( /^$numbers/ ) {
219 0           $converted .= (" "x$listDepth)."* $_\n";
220             }else {
221 0           $converted .= "$_\n\n";
222             }
223             }
224             }
225 0           when ( /$self->{rules}->{MimeTableNewLine}/ ) {
226              
227             }
228 0           when ( /$self->{rules}->{MimeTableCap}/ ) {
229 0           $converted = "| $1 |\n"; # Matched -> | Matched |
230             }
231 0           when ( /$self->{rules}->{List}/ ) {
232 0           $converted = " $1*$2\n";
233             }
234 0           when ( /$self->{rules}->{FunctionDetecting}/ ) {
235 0           $converted = "\n\n$_\n\n";
236             }
237 0           when ( /$self->{rules}->{indent}/ ){
238 0           $converted = "\n\n$1\n\n";
239             }
240 0           default {
241 0           $converted = $_."\n\n";
242             }
243             }
244              
245             #Link Method Change [word][linkNumberKey] -> [[linkNumberKey][word]]
246 0 0         $converted =~ s/\[(.*?)\]\[(\d+)\]/[[$2][$1]]/g if defined ($converted);
247              
248             # insert converted line
249 0 0         $lines[$LP] = defined($converted)? $converted:"";
250              
251             # Increase line pointer
252 0           $LP++;
253             }
254              
255             # restructure link
256 0           for ( @link_list ) {
257 0 0 0       if ( defined($_) and /^(http\:\/\/){0}(?[^\/].+?)(\.([a-z]+)(|\#.*))$/ ) {
258 1     1   1286 $_ = $self->{config}{InterLinkBase}.$+{filename};
  1         773  
  1         719  
  0            
259             }
260             }
261              
262             # apply link and remove empty link
263 0           for ( @lines ) {
264 0           s/\[\[(\d+)\]\[(.*?)\]\]/[[$link_list[$1]][$2]]/g;
265 0           s/\[\[\]\[(.*?)\]\]/$1/g;
266             }
267 0 0         $result .= defined($_)? $_:"" for @lines;
268              
269              
270             # merge split code block
271 0           $result =~ s/(\<\/verbatim\>\s*\)|(\%ENDCODE\%\s*\%CODE\{.*?\}\%)//gs;
272              
273 0           $result = $self->{config}->{head_contents}.$result;
274 0           $result = $self->{config}->{header_text}.$result;
275 0           $result = $result.$self->{config}->{foot_contents};
276 0           $result = $result.$self->{config}->{footer_text};
277 0           return $result;
278             }
279              
280             sub word_replace {
281             # replace to invaild characters ex) & > &
282 0     0 0   my $text = shift;
283 0           my %words_ref = ( "\&" => "&" , # & -> &
284             "\\\\" => "", # \ -> space
285             "<>" => "",
286             "\>" => ">",
287             "\<" => "<",
288             );
289            
290 0           for ( keys %words_ref ) {
291 0           $text =~ s/$_/$words_ref{$_}/g;
292             }
293 0           return $text;
294             }
295              
296             sub save {
297 0     0 1   shift;
298 0           my ($text,$dir,$newfile) = @_;
299              
300 0           $newfile =~ s/([a-z])/uc($1);/e;
  0            
301 0   0       $dir = $dir || '.';
302              
303 0 0         open my $fh , ">", "$dir/$newfile" or die "can't save to file: $!";
304 0 0         print $fh $text or die "can't writes text: $!" ;
305 0           close $fh;
306            
307 0           return 1;
308             }
309              
310             1;
311             __END__