use v6; use File::Spec; # todo_ # all :perl5 # subs and each_line => 1 my $prog_name = $*PROGRAM_NAME; $prog_name ~~ s:perl5:g{\\}{\/}; my ( $path ) = splitpath( $prog_name )[1]; $path ||= '.'; my $conf_fp; my $dg = 1; if ( @ARGS[0] ) { $conf_fp = @ARGS[0]; $path = splitpath( $conf_fp )[1]; } else { $conf_fp = "$path/conf.p6"; } say ~$path if $dg; # todo_ require problem #my $conf_raw = require $conf_fp || die "Conf file '$conf_fp' not loaded;"; #my %conf = hash( $conf_raw ); my %conf = { index => [ # { src => './tut_src/hello-world.p6', dest_dir => 'base', }, # { src => './tut_src/hello-world-ad.p6', dest_dir => 'base', }, # { src => './tut_src/', dest_dir => 'tut', }, ], add_others=> 1, tut_src_dir => './tut-src', pugs => 'pugs', #pugs => './../../pugs', output_dir => './tut-output', each_line => 0, # temprorary files temp_fp => './tut-temp.p6', temp_out_fp => './tut-temp.out', # html output_type => 'html', output_suffix => '.html', tut_src_rel => './../tut-src', # TODO # raw # output_type => 'raw', # output_suffix => '.txt', }; say %conf.ref ~ ' ' ~ %conf if $dg; #say %conf.ref; say %conf..ref; my $os; $os = 'win32' if lc($?OS) eq any; say 'os: ' ~ $os if $dg; my $os; say ~$path; for %conf.keys -> $key { die "Conf keys 'f_*' are reserved!\n" if $key ~~ rx:perl5{^f_}; if ( $key ~~ rx:perl5{_fp$} ) { %conf{'f_' ~ $key} = catfile( $path, %conf{$key} ); } elsif ( $key ~~ rx:perl5{_dir$} ) { %conf{'f_' ~ $key} = catdir( $path, %conf{$key} ); } else { # todo_ #next; } say "$key : %conf{$key}" if $dg; # todo_ if next say "f_$key: %conf{'f_' ~ $key}" if $dg; } say ''; my $pugs = %conf; $pugs = catfile( $path, $pugs ) if $pugs ~~ rx:perl5{^[\.\\\/]}; if ( $os eq 'win32' ) { $pugs ~~ s:perl5:g{\/}{\\}; $pugs ~= '.exe' unless $pugs ~~ rx:perl5{\.exe$}; } say 'pugs: ' ~ $pugs ~ "\n" if $dg; my $stat = system( "$pugs -v" ); # TODO #die "Pugs '$pugs' run test failed (code $stat)!\n" if $stat != 0; my $out_dir = %conf; unless -d $out_dir { mkdir $out_dir or die "Output dir '$out_dir' create error:\n"; } my $out_suffix; if defined %conf { $out_suffix = %conf; } elsif %conf eq 'html' { $out_suffix = '.html'; } else { $out_suffix = '.txt'; } if %conf eq 'html' { unless defined %conf { die "File::Spec bug"; %conf = abs2rel( %conf, %conf ); } %conf ~~ s:perl5:g{\\}{\/}; } die "Source file directory '%conf ('%conf') not found!" unless -d %conf; sub get_output ( Str $tut_fp, +$each_line = 0 ) { my $file_t = slurp $tut_fp || die "Slurp failed '$tut_fp'\n"; my @parts = ( $each_line ) ?? split( "\n", $file_t ) :: split( "\n\n", $file_t ); my $new_pl = ''; for @parts.kv -> $part_num, $part { $new_pl ~= $part ~ "\n"; # TODO #unless $part ~~ rx:perl5{^\s*$} { $new_pl ~= 'print "#~# ' ~ $part_num ~ ' #~#\n";'; # todo_ waiting for io_redirect_to_scalar # $new_pl ~= '$*ERR.print("#!# ' ~ $part_num ~ ' #!#\n");'; $new_pl ~= "\n"; #} } say $new_pl; # todo_ #my $out, $err; #open $*OUT,">", \$out; #open $*OUT,">", \$err; #my $status = eval $new_pl; #say $status; my $fh_p6_temp = open %conf, :w; print $fh_p6_temp, $new_pl; close $fh_p6_temp; my $cmd = "$pugs %conf > %conf"; say "running: '$cmd'\n"; my $status = system $cmd; my $out = slurp %conf; unlink %conf; say ~ '-' x 60 ~ " out b --\n" ~ $out ~ "\n" ~ '-' x 60 ~ ' out e --' if $dg; # my @out_parts = split( rx:perl5{#~# \d+ #~#}, $out); my @out_parts = split( rx:perl5{#~# \d+ #~}, $out); # todo_ #for @out_parts -> $out_part is rw { # $out_part = undef; ... for @out_parts.keys -> $idx { my $out_part = @out_parts[$idx]; if $out_part ~~ rx:perl5{^#\s*$} { @out_parts[$idx] = undef; } else { @out_parts[$idx] ~~ s:perl5{^#\n}{}; $out_part ~~ s:perl5{\n$}{} if $each_line; } } return \@parts, \@out_parts; } sub gen_html ( @parts, @out_parts, Str $prev_tut_fn, Str $tut_fn, Str $next_tut_fn, Str $out_dir, Str +$suffix ) { use HTML::Entities; my ( $part, $out_part ); say ~@out_parts; my $html_fp = catfile( $out_dir, $tut_fn ~ $suffix ); my $fh_html = open '>' ~ $html_fp; # ===== html =====>> say $fh_html, qq| Perl6-Pugs Tutorial


|; # <<===== my $out_part; for @parts.kv -> $part_num, $part { $out_part = @out_parts[$part_num]; say ~ '-' x 20 ~ " $part_num in_part -----\n" ~ $part ~ "\n" ~ '-' x 20 ~ " $part_num out_part ----\n" ~ '-' x 20 ~ "\n" ~ $out_part ~ "\n" ~ '-' x 20 ~ ' $part_num out_part e --' if $dg; # ===== html =====>> say $fh_html, qq| { if $out_part { qq|| } else { qq||; } } |; # <<===== } # TODO s{./../tut}{abs2rel} # ===== html =====>> say $fh_html, qq|
{encode_entities $part}
{encode_entities $out_part}
{$tut_fn} src \  \  src dir
|; # <<===== close $fh_html; } my @prep_index = *%conf; if %conf { # todo_ maybe # my %index{ @prep_index } >>= 1; my %index; for @prep_index -> $key { %index{$key} = 1; } my @ls = sort readdir %conf; for @ls -> $each { # todo_ #next unless -f $each; #next if exists %index{$fn}; if ( ( $each ~~ rx:perl5{\.p6$} ) && ( -f catfile(%conf, $each) ) && ( not %index{$each} ) ) { push @prep_index, $each; } } } say ~@prep_index if $dg; my ( $tut_fp, $tt_vars ); my ( $tut_fn, $prev_tut_fn, $next_tut_fn ); # todo_ autrijus "zip() is in." for @prep_index.kv -> $idx, $tut_fn { if ( $idx > 0 ) { $prev_tut_fn = @prep_index[$idx-1] } else { $prev_tut_fn = undef }; if ( $idx + 1 < @prep_index.elems ) { $next_tut_fn = @prep_index[$idx+1] } else { $next_tut_fn = undef }; say "p:'$prev_tut_fn' a:'$tut_fn' n:'$next_tut_fn'"; $tut_fp = catfile %conf, $tut_fn; my ( @parts, @out_parts ); # todo_ # { my $r = get_output( $tut_fp, each_line => %conf ); @parts = $r[0], @out_parts = $r[1] } { my $r = get_output( $tut_fp, each_line => %conf{'each_line'} ); @parts = $r[0], @out_parts = $r[1] } say "parts: {+@parts}, out_parts: {+@out_parts}" if $dg; gen_html( @parts, @out_parts, $prev_tut_fn, $tut_fn, $next_tut_fn, $out_dir, suffix => $out_suffix ); }