$ ./7.cw1.pl Useless use of string in void context at template_stuff/utils1.pm line 164. Subroutine html7::getcwd redefined at /usr/share/perl/5.26/Exporter.pm line 66. at template_stuff/html7.pm line 295. title is 7.cw path1 is /home/bob/2.scripts/pages/7.cw abs is /home/bob/2.scripts/pages/7.cw/7.cw1.pl [ ["\x{439}", " ", " ", "\x{43B}", " ", " ", "\x{441}", " ", " "], [ "\x{43E}", "\x{431}", "\x{43B}", "\x{43E}", "\x{43C}", "\x{43E}", "\x{432}", "'", "'", "\x{448}", ], [1 .. 9], ] ini path is /home/bob/Documents/html_template_data/3.values.ini ... content---------- a is /home/bob/2.scripts/pages/7.cw/template_stuff/aimages/c.png b is c.png a is /home/bob/2.scripts/pages/7.cw/template_stuff/aimages/d.jpg b is d.jpg return is 7.cw7.html http:/www.merrillpjensen.com/perlmonks/7.cw7.html ultimate disposition of main hash------- $VAR1 = { 'chapter' => "\x{41a}\x{440}\x{43e}\x{441}\x{441}\x{432}\x{43e}\x{440}\x{434}\x{44b}", 'make_puzzle' => 1, 'oibottom' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/oibottom.txt', '/home/bob/2.scripts/pages/7.cw/template_stuff/oibottom.txt' ], 'Path::Tiny' ), 'css_path' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff', '/home/bob/2.scripts/pages/7.cw/template_stuff' ], 'Path::Tiny' ), 'footer' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/footer_center3.txt', '/home/bob/2.scripts/pages/7.cw/template_stuff/footer_center3.txt' ], 'Path::Tiny' ), 'translations' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/translations', '/home/bob/2.scripts/pages/7.cw/template_stuff/translations' ], 'Path::Tiny' ), 'eng_captions' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/captions', '/home/bob/2.scripts/pages/7.cw/template_stuff/captions' ], 'Path::Tiny' ), 'module_tmpl' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/code3.tmpl', '/home/bob/2.scripts/pages/7.cw/template_stuff/code3.tmpl' ], 'Path::Tiny' ), 'to_images' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/aimages', '/home/bob/2.scripts/pages/7.cw/template_stuff/aimages' ], 'Path::Tiny' ), 'rus_captions' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/ruscaptions', '/home/bob/2.scripts/pages/7.cw/template_stuff/ruscaptions' ], 'Path::Tiny' ), 'ts' => 'template_system', 'print_script' => '1', 'print_module' => 0, 'image_dir' => 'pmimage', 'header' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/hc_input2.txt', '/home/bob/2.scripts/pages/7.cw/template_stuff/hc_input2.txt' ], 'Path::Tiny' ), 'oitop' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/oitop.txt', '/home/bob/2.scripts/pages/7.cw/template_stuff/oitop.txt' ], 'Path::Tiny' ), 'base_url' => 'http://www.merrillpjensen.com', 'code_tmpl' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/code2.tmpl', '/home/bob/2.scripts/pages/7.cw/template_stuff/code2.tmpl' ], 'Path::Tiny' ), 'cw_data' => [ [ "\x{439}", ' ', ' ', "\x{43b}", ' ', ' ', "\x{441}", ' ', ' ' ], [ "\x{43e}", "\x{431}", "\x{43b}", "\x{43e}", "\x{43c}", "\x{43e}", "\x{432}", '\'', '\'', "\x{448}" ], [ 1, 2, 3, 4, 5, 6, 7, 8, 9 ] ], 'book' => 'Crosswords: ', 'body' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/rebus5.tmpl', '/home/bob/2.scripts/pages/7.cw/template_stuff/rebus5.tmpl' ], 'Path::Tiny' ), 'bottom' => bless( [ '/home/bob/2.scripts/pages/7.cw/template_stuff/bottom1.txt', '/home/bob/2.scripts/pages/7.cw/template_stuff/bottom1.txt' ], 'Path::Tiny' ), 'css_file' => '7.cw1.css', 'server_dir' => 'perlmonks', 'place' => 'Vancouver', 'script_file' => '/home/bob/2.scripts/pages/7.cw/7.cw1.pl', 'title' => '7.cw', 'headline' => undef }; $ #### $ cat html7.pm package html7; require Exporter; use utils1; our @ISA = qw(Exporter); our @EXPORT = qw( get_content write_body get_html_filename create_html_file write_script write_bottom write_header write_footer write_module get_tiny create_page put_page ); sub create_page { use 5.011; use trans2; #goes with yandex for default use Net::SFTP::Foreign; use POSIX; use Encode; use open OUT => ':encoding(UTF-8)', ':std'; #create html page my $rvars = shift; my %vars = %$rvars; my $sftp = get_tiny(); say "object created, back with caller"; my $html_file = get_html_filename( $sftp, $rvars ); $vars{html_file} = $html_file; print "Make rus captions(y/n)?: "; my $prompt1 = ; chomp $prompt1; if ( $prompt1 eq ( "y" | "Y" ) ) { ## delete existing files foreach my $child ( $vars{rus_captions}->children ) { my $success = $child->remove; say "success deleting was $success"; } my $ref_cap = make_russian_captions($rvars); } my $fh = create_html_file($html_file); my $remote_dir = $html_file; $remote_dir =~ s/\.html$//; say "remote_dir is $remote_dir"; $vars{remote_dir} = $remote_dir; $rvars = \%vars; ## why so necessary? ##testing persistence $vars{chance} = "Марков"; # create header my $rhdr = write_header($rvars); print $fh $$rhdr; $vars{refc} = get_content($rvars); $rvars = \%vars; ## will same trick work? ## will this survive after ref dies? my $body = write_body( $rvars, $vars{refc} ); print $fh $$body; if ( $vars{"make_puzzle "} ) { my $return = make_russian_crossword($rvars); say "return is $return"; } my $rftr = write_footer($rvars); print $fh $$rftr; if ( $vars{"print_script"} ) { my $script = write_script($rvars); print $fh $$script; } if ( $vars{"print_module"} ) { my $module = write_module($rvars); print $fh $$module; } my $rhbt = write_bottom($rvars); print $fh $$rhbt; close $fh; print "Put file to server(y/n)?: "; my $prompt2 = ; chomp $prompt2; if ( $prompt2 eq ( "y" | "Y" ) ) { put_page( $sftp, $rvars ); } return $html_file; } sub put_page { use 5.011; #use nibley1; use utils1; use Net::SFTP::Foreign; use Encode; use open OUT => ':encoding(UTF-8)', ':std'; use Data::Dumper; my ( $sftp, $rvars ) = (@_); my %vars = %$rvars; #load html file to server my $server_dir = $vars{"server_dir"}; say "server dir is $server_dir"; $sftp->mkdir("/$server_dir") or warn "mkdir1 failed $!\n"; $sftp->setcwd("/$server_dir") or warn "setcwd1 failed $!\n"; $sftp->put( $vars{html_file} ) or die "html put failed $!\n"; #load css file to server $sftp->setcwd("/css") or warn "setcwd2 failed $@\n"; my $path3 = path( $vars{css_path}, $vars{"css_file"} ); say "path3 is $path3"; my $remote_css = $vars{"css_file"}; $sftp->put( "$path3", $remote_css ) or warn "css put failed $@\n"; # upload images my $image_dir = $vars{"image_dir"}; $sftp->mkdir("/$image_dir") or warn "mkdir2 failed $!\n"; $sftp->setcwd("/$image_dir") or warn "setcwd2 failed $!\n"; $sftp->mkdir( $vars{remote_dir} ) or warn "mkdir3 failed $!\n"; $sftp->setcwd( $vars{remote_dir} ) or warn "setcwd3 failed $!\n"; print $sftp->cwd(), "\n"; #say "page hash is------------ "; #print Dumper $rvars; my $ref_content = $vars{refc}; my @AoA = @$ref_content; say "content----------"; #print Dumper $ref_content; for my $i ( 0 .. $#AoA ) { #say "first value is $vars{to_images} "; #say "array part is $AoA[$i][0]"; if ( !defined $AoA[$i][0] ) { say "undefined!...initializing:"; $AoA[$i][0] = 'quux'; } my $a = path( $vars{to_images}, $AoA[$i][0] ); say "a is $a"; my $b = $a->basename; say "b is $b"; $sftp->put( $a, $b ) or warn "AoA put failed $@\n"; } undef $sftp; return "nothing"; } sub get_content { use 5.010; my $rvars = shift; my %vars = %$rvars; my $refimg = get_images($rvars); my $refcaps = get_utf8_text( $rvars, $vars{"eng_captions"} ); my $refruscaps = get_utf8_text( $rvars, $vars{"rus_captions"} ); my $aoa = [ $refimg, $refcaps, $refruscaps ]; my $b = invert_aoa($aoa); return ($b); } sub get_images { use 5.011; use Data::Dumper; my $rvars = shift; my %vars = %$rvars; #print Dumper $rvars; my @filetypes = qw/jpg gif png jpeg GIF/; my $pattern = join '|', map "($_)", @filetypes; my @matching2; #say "value is $vars{to_images}"; opendir my $hh, $vars{to_images} or warn "warn $!\n"; while ( defined( $_ = readdir($hh) ) ) { if ( $_ =~ /($pattern)$/i ) { push( @matching2, $_ ); } } #important to sort @matching2 = sort @matching2; return \@matching2; } sub get_utf8_text { use 5.010; use HTML::FromText; use Path::Tiny; use utf8; use open qw/:std :utf8/; ### Passing in #reference to main data structure and directory for captions my ( $rvars, $dir ) = (@_); my %vars = %$rvars; say "dir is $dir"; opendir my $eh, $dir or warn "can't open dir for utf8 captions $!\n"; while ( defined( $_ = readdir($eh) ) ) { next if m/~$/; next if -d; if (m/txt$/) { my $file = path( $dir, $_ ); my $guts = $file->slurp_utf8; my $temp = text2html( $guts, urls => 1, email => 1, paras => 1, ); # surround by divs my $oitop = $vars{"oitop"}; my $oben = $oitop->slurp_utf8; my $oibottom = $vars{"oibottom"}; my $unten = $oibottom->slurp_utf8; my $text = $oben . $temp . $unten; #say "text is $text"; $content{$_} = $text; } } closedir $eh; #important to sort my @return; foreach my $key ( sort keys %content ) { #print $content{$key} . "\n"; push @return, $content{$key}; } return \@return; } sub write_body { use warnings; use 5.011; use Text::Template; use Encode; my $rvars = shift; my $reftoAoA = shift; my %vars = %$rvars; my @AoA = @$reftoAoA; my $body = $vars{"body"}; my $template = Text::Template->new( ENCODING => 'utf8', SOURCE => $body ) or die "Couldn't construct template: $!"; my $return; for my $i ( 0 .. $#AoA ) { $vars{"file"} = $AoA[$i][0]; $vars{"english"} = $AoA[$i][1]; my $ustring = $AoA[$i][2]; $vars{"russian"} = $ustring; my $result = $template->fill_in( HASH => \%vars ); $return = $return . $result; } return \$return; } sub write_bottom { use strict; use Text::Template; my ($rvars) = shift; my %vars = %$rvars; my $footer = $vars{"bottom"}; my $template = Text::Template->new( SOURCE => $footer ) or die "Couldn't construct template: $!"; my $result = $template->fill_in( HASH => $rvars ); return \$result; } sub get_html_filename { use Net::SFTP::Foreign; use File::Basename; use Cwd; use 5.01; binmode STDOUT, ":utf8"; my ( $sftp, $rvars ) = (@_); my %vars = %$rvars; # get working directory my $word = $vars{"title"}; say "word is $word"; # get files from /pages my $dir2 = $vars{"server_dir"}; say "dir2 is $dir2"; my $ls = $sftp->ls( "/$dir2", wanted => qr/$word/ ) or warn "unable to retrieve " . $sftp->error; print "$_->{filename}\n" for (@$ls); my @remote_files = map { $_->{filename} } @$ls; say "files are @remote_files"; my $rref = \@remote_files; my $filetype = "html"; my $old_num = highest_number( $rref, $filetype, $word ); print "old num is $old_num\n"; my $new_num = $old_num + 1; my $html_file = $word . $new_num . '.' . $filetype; return $html_file; } sub create_html_file { my $html_file = shift; open( my $fh, ">>:encoding(UTF-8)", $html_file ) or die("Can't open $html_file for writing: $!"); return $fh; } sub write_header { use Text::Template; use 5.011; use warnings; my $rvars = shift; my %vars = %$rvars; # get time my $now_string = localtime; $vars{"date"} = $now_string; my $headline = join( ' ', $vars{"book"}, $vars{"chapter"} ); $vars{"headline"} = $headline; my $header = $vars{"header"}; my $template = Text::Template->new( ENCODING => 'utf8', SOURCE => $header, ) or die "Couldn't construct template: $!"; my $result = $template->fill_in( HASH => \%vars ); say "result is $result"; return \$result; } sub write_footer { use Text::Template; my ($rvars) = shift; my %vars = %$rvars; my $footer = $vars{"footer"}; my $template = Text::Template->new( SOURCE => $footer ) or die "Couldn't construct template: $!"; my $result = $template->fill_in( HASH => $rvars ); return \$result; } sub write_script { use Text::Template; use 5.010; use utf8; my ($rvars) = shift; my %vars = %$rvars; my $tmpl = $vars{"code_tmpl"}; say "tmpl is $tmpl"; my $file = $vars{"script_file"}; my $text = do { open my $fh, '<:raw:encoding(UTF-8)', $file or die "$file: $!"; local $/; <$fh>; }; my %data = ( 'script', $text ); my $template = Text::Template->new( SOURCE => $tmpl ) or die "Couldn't construct template: $!"; my $result = $template->fill_in( HASH => \%data ); return \$result; } sub write_module { use 5.010; use File::Spec; use Text::Template; use utf8; my ($rvars) = shift; my %vars = %$rvars; my $tmpl = $vars{"module_tmpl"}; say "tmpl is $tmpl"; my $file = File::Spec->rel2abs(__FILE__); my $text = do { open my $fh, '<:raw:encoding(UTF-8)', $file or die "$file: $!"; local $/; <$fh>; }; my %data = ( 'module', $text ); my $template = Text::Template->new( SOURCE => $tmpl ) or die "Couldn't construct template: $!"; my $result = $template->fill_in( HASH => \%data ); return \$result; } sub get_tiny { use 5.011; use warnings; use Net::SFTP::Foreign; use Config::Tiny; use Data::Dumper; my $ini_path = qw( /home/bob/Documents/html_template_data/3.values.ini ); say "ini path is $ini_path"; my $sub_hash = "my_sftp"; my $Config = Config::Tiny->new; $Config = Config::Tiny->read( $ini_path, 'utf8' ); say Dumper $Config; # -> is optional between brackets my $domain = $Config->{$sub_hash}{'domain'}; my $username = $Config->{$sub_hash}{'username'}; my $password = $Config->{$sub_hash}{'password'}; my $port = $Config->{$sub_hash}{'port'}; #dial up the server say "values are $domain $username $password $port"; my $sftp = Net::SFTP::Foreign->new( $domain, #more => '-v', user => $username, port => $port, password => $password ) or die "Can't connect: $!\n"; return $sftp; } 1; $ #### $ cat utils1.pm package utils1; require Exporter; use utf8; our @ISA = qw(Exporter); our @EXPORT = qw( invert_aoa print_aoa getsubset highest_number rangeparse print_aoa_utf8 make_russian_crossword get_тайный); sub invert_aoa { use strict; use warnings; use 5.011; my $a = shift; my @AoA = @$a; my $k = $#AoA; #say "k is $k"; my @BoB; for my $i ( 0 .. $#AoA ) { my $aref = $AoA[$i]; my $x = $#{$aref}; #say "x is $x"; for my $j ( 0 .. $#{$aref} ) { $BoB[$j][$i] = $AoA[$i][$j]; } } my $b = \@BoB; return $b; } sub print_aoa_utf8 { use warnings; use 5.011; use utf8; # a la François use open OUT => ':encoding(utf8)'; use open ':std'; my $a = shift; my @AoA = @$a; for my $i ( 0 .. $#AoA ) { my $aref = $AoA[$i]; for my $j ( 0 .. $#{$aref} ) { print "elt $i $j is $AoA[$i][$j]\n"; } } return $a; } sub print_aoa { use warnings; use 5.011; my $a = shift; my @AoA = @$a; for my $i ( 0 .. $#AoA ) { my $aref = $AoA[$i]; for my $j ( 0 .. $#{$aref} ) { print "elt $i $j is $AoA[$i][$j]\n"; } } return $a; } sub highest_number { use 5.011; my ( $aref, $filetype, $word ) = @_; my $number; my @matching; my $ext = "." . $filetype; push( @matching, 0 ); #min returned value for my $file ( @{$aref} ) { #print "file is $file\n"; if ( $file =~ /^$word(\d+)$ext$/ ) { print "matching is $file\n"; push( @matching, $1 ); } } @matching = sort { $a <=> $b } @matching; my $winner = pop @matching; return $winner } sub rangeparse { use Carp; local $_ = shift; my @o; # [ row1,col1, row2,col2 ] (-1 = last row/col) if ( @o = /\AR([0-9]+|n)C([0-9]+|n):R([0-9]+|n)C([0-9]+|n)\z/ ) { } elsif (/\AR([0-9]+|n):R([0-9]+|n)\z/) { @o = ( $1, 1, $2, -1 ) } elsif (/\AC([0-9]+|n):C([0-9]+|n)\z/) { @o = ( 1, $1, -1, $2 ) } elsif (/\AR([0-9]+|n)C([0-9]+|n)\z/) { @o = ( $1, $2, $1, $2 ) } elsif (/\AR([0-9]+|n)\z/) { @o = ( $1, 1, $1, -1 ) } elsif (/\AC([0-9]+|n)\z/) { @o = ( 1, $1, -1, $1 ) } else { croak "failed to parse '$_'" } $_ eq 'n' and $_ = -1 for @o; return \@o; } sub getsubset { use Carp; my ( $data, $range ) = @_; my $cols = @{ $$data[0] }; @$_ == $cols or croak "data not rectangular" for @$data; $range = rangeparse($range) unless ref $range eq 'ARRAY'; @$range == 4 or croak "bad size of range"; my @max = ( 0 + @$data, $cols ) x 2; for my $i ( 0 .. 3 ) { $$range[$i] = $max[$i] if $$range[$i] < 0; croak "index $i out of range" if $$range[$i] < 1 || $$range[$i] > $max[$i]; } croak "bad rows $$range[0]-$$range[2]" if $$range[0] > $$range[2]; croak "bad cols $$range[1]-$$range[3]" if $$range[1] > $$range[3]; my @cis = $$range[1] - 1 .. $$range[3] - 1; return [ map { sub { \@_ } ->( @{ $$data[$_] }[@cis] ) } $$range[0] - 1 .. $$range[2] - 1 ]; } sub make_russian_crossword { use 5.011; use warnings; use POSIX qw(strftime); use Path::Tiny; use Encode; use open OUT => ':encoding(UTF-8)', ':std'; use Data::Dumper; my $rvars = shift; my %vars = %$rvars; my $munge = strftime( "p%d-%m-%Y-%H-%M-%S\.txt", localtime); my $in_path = path( $vars{rus_captions}, $munge )->touchpath; ##Let mother know that you created a file, *verb* a reference: $vars{log_file}=$in_path; $rvars = \%vars; #does this line do anything for me? # open file for writing # my $fh = path($in_path)->openw_utf8; not helping say "in make russian xword------"; my $data = $vars{cw_data}; #print Dumper $data; print_aoa_utf8($data); #print $fh $data; my $a = $data; my @AoA = @$a; for my $i ( 0 .. $#AoA ) { my $aref = $AoA[$i]; for my $j ( 0 .. $#{$aref} ) { "$AoA[$i][$j]"; } print "\n"; } # ->append_utf8(@data); return "nothing nyet" } sub get_тайный { use 5.011; use warnings; use utf8; use Net::SFTP::Foreign; use Config::Tiny; use Data::Dumper; use open OUT => ':encoding(utf8)'; use open ':std'; my $ini_path = qw( /home/bob/Documents/html_template_data/3.values.ini ); say "ini path is $ini_path"; my $sub_hash = "my_sftp"; my $Config = Config::Tiny->new; $Config = Config::Tiny->read( $ini_path, 'utf8' ); say Dumper $Config; # -> is optional between brackets my $domain = $Config->{$sub_hash}{'domain'}; my $username = $Config->{$sub_hash}{'username'}; my $password = $Config->{$sub_hash}{'password'}; my $port = $Config->{$sub_hash}{'port'}; #dial up the server say "values are $domain $username $password $port"; my $sftp = Net::SFTP::Foreign->new( $domain, #more => '-v', user => $username, port => $port, password => $password ) or die "Can't connect: $!\n"; return $sftp; } 1; $ #### $ cat nibley1.pm package nibley1; require Exporter; use config1; use utils1; our @ISA = qw(Exporter); our @EXPORT = qw( text_to_captions ); sub get_text { use 5.010; use File::Slurp; my ($rvars) = shift; my %vars = %$rvars; my $word_hash_ref = zip_lists( $vars{'words'}, $vars{'subs'} ); my %hash = %$word_hash_ref; my $check = join '|', keys %hash; open( my $hh, "<:encoding(UTF-8)", $vars{'source'} ) || die "can't open UTF-8 encoded filename: $!"; my $text; while (<$hh>) { $_ =~ s/($check)/$hash{$1}/gi; $_ =~ s/[^[:ascii:]]+/ /g; # $_ =~ s%
%%; say "default is $_"; $text = $text . $_; } return $text; } sub text_to_captions { use 5.010; use File::Slurp; use Path::Class; my ($rvars) = shift; my %vars = %$rvars; my $text = get_text($rvars); say "text is $text"; my $name = $vars{"book"} . $vars{"chapter"} . '.' . "txt"; say "name is $name"; my $temp = $vars{"path"}; say "temp is $temp"; my $file = file( $vars{"path"}, $name ); say "file is $file"; open( my $fh, ">:encoding(UTF-8)", $file ) or die("Can't open $file for writing: $!"); print $fh $text; close $fh; } 1; #### while (<$hh>) { $_ =~ s/($check)/$hash{$1}/gi; $_ =~ s/[^[:ascii:]]+/ /g; # $_ =~ s%
%%; say "default is $_"; $text = $text . $_; } #### $ touch 1.mp.txt $ gedit 1.mp.txt & [1] 11120 $ trans :de file://1.mp.txt Ich winke meine privaten Teile an Ihre Tanten, Sie käsige Menge gebrauchte elektrische Esel-Bottom-Beißer. [1]+ Done gedit 1.mp.txt $ cat 1.mp.txt I wave my private parts at your aunties, you cheesy lot of second hand electric donkey-bottom biters. $