source: genappalpha/bin/genapp_run.pl @ 1491

Last change on this file since 1491 was 1491, checked in by ehb, 2 years ago

remove debugging messages

  • Property svn:executable set to *
File size: 47.4 KB
Line 
1#!/usr/bin/perl
2
3$notes = "usage: $0 {-d{?}}
4checks the files
5note: env variable GENAPP must be defined
6options:
7-d debug mode
8 -dr show replacements
9 -dc conditional replacements
10 -ds show inline replacements
11 -do special for once:field:id messages
12 -sr print detailed repeater info and exit after that point
13 -gd generate graphviz .dot files for the application and exit after that point
14-h prints this message
15" ;
16
17$gap = $ENV{ "GENAPP" } || die "$0: error env variable GENAPP must be defined\n";
18
19use File::Basename;
20
21while ( $ARGV[ 0 ] =~ /^-(\w{1,2})/ )
22{
23    my $arg = $1;
24    print "arg is $arg\n";
25    shift;
26    if ( $arg =~ /^d(\w?)/ )
27    {
28        if ( $1 eq 'r' )
29        {
30            $debug_rplc++;
31        }
32        if ( $1 eq 'c' )
33        {
34            use Data::Dumper;                               
35            $debug_crplc++;
36        }
37        if ( $1 eq 's' )
38        {
39            use Data::Dumper;                               
40            $debug_srplc++;
41        }
42        if ( $1 eq 'o' )
43        {
44            $debug_oncefield++;
45            next;
46        }
47        $debug_main++;
48        next;
49    }
50    if ( $arg =~ /^s(\w?)/ )
51    {
52        if ( $1 eq 'r' )
53        {
54            $show_repeaters++;
55            next;
56        }
57    }
58    if ( $arg =~ /^g(\w?)/ )
59    {
60        if ( $1 eq 'd' )
61        {
62            $graphviz++;
63            next;
64        }
65    }
66       
67    if ( $arg eq 'h' )
68    {
69        print $notes;
70        exit;
71    }
72    die "$0: unrecognized option '-$1'\n\n$notes";
73}
74
75require "$gap/etc/perl/genapp_util.pl";
76
77check_files() || die "Errors found\n";
78
79print $warn ? "preliminary checks had warnings\n" :  "preliminary checks ok\n";
80
81# test_get_replacements();
82# test_get_cond_replacements();
83
84my $error;
85my $warn;
86my $notice;
87my $created;
88my $ref_directives = {};
89my $ref_menu       = {};
90#my $ref_config     = {};
91my $rplc           = {};
92
93# $rplc{ "directives" } = start_json( $directives, $ref_directives );
94$rplc_directives = start_json( $directives, $ref_directives );
95
96my $path = `pwd`;
97chomp $path;
98
99while ( my ( $k, $v ) = each %$rplc_directives )
100{
101    print "$k $v\n" if $debug_srplc;
102}
103print "menu start_json\n" if $debug_main;
104# $rplc{ "menu" }       = start_json( $menu      , $ref_menu       );
105
106foreach my $l ( keys %langs )
107{
108    my @post_cmds;
109    print '-'x60 . "\n";
110    print "processing language $l\n";
111    print '-'x60 . "\n";
112
113    # reload for language specific content
114    $directives = add_special_directives( get_file_json_lang_specific( "directives.json", $l, 0 ) );
115    $rplc_directives = start_json( $directives, $ref_directives );
116
117    # reload for language specific content
118    $menu = get_file_json_lang_specific( "menu.json", $l, 1 );
119    $rplc_menu   = start_json( $menu,   $ref_menu );
120#    print "module to file\n";
121#    print Dumper( %module_to_file );
122   
123#    $rplc_config = start_json( $config, $ref_config );
124#    $rplc{ "directives" } = rewind_json( $ref_directives );
125    $lang = get_lang_json( $l );
126    my $options = $$lang{ "options" };
127    my $options_imagesinline = $options && $$options{ "imagesinline" };
128#    print "options: " . Dumper( $options ) . "\n";
129#    print "imagesinline " . (  $options_imagesinline ? "true" : "false" ) . "\n";
130   
131    undef %created;
132    for ( my $i = 0; $i < @{@$lang{ "assembly" }}; ++$i ) # for each assembly step (from language)
133    {
134        print '='x80 . "\n";
135        my $use     = $$lang{ "assembly" }[ $i ];
136        my $freq    = $$use{ "frequency" };
137        my $prefix  = $$use{ "prefix" } && $$use{ "prefix" } eq 'enable';
138        my $output  = $$use{ "output" };
139        my $setexec = $$use{ "setexecutable" };
140        my $clobber = $$use{ "clobber" };
141        my $inputs  = $$use{ "inputs" };
142        my $minify  = $$use{ "minify" };
143        my $closure = $$use{ "closure" };
144        my $doexec  = $$use{ "execute" } =~ /^(atend|true)/ ? $$use{ "execute" } : 0;
145        if ( $minify ) {
146            my $mok = 0;
147            if ( $minify eq "minify" )
148            {
149                print "minify via minify requested";
150                undef $minify if !`which minify 2>/dev/null`;
151                print " and found!" if $minify;
152                print "\n";
153                $mok = 1;
154            }
155            if ( $minify eq "closure" )
156            {
157                print "minify via closure requested";
158                undef $minify if !-e "$gap/etc/closure_compiler.jar";
159                print " and found!" if $minify;
160                print "\n";
161                $mok = 1;
162            }
163            if ( $minify eq "copy" )
164            {
165                print "minify via copy requested";
166                print "\n";
167                $mok = 1;
168            }
169            if ( !$mok ) {
170                $error .= "language $l: minify via $minify requested but unsupported\n";
171            }
172        }
173
174        if ( $doexec ) {
175            print "output will be executed " . ( $doexec eq 'atend' ? "after all output generation" : "" ) . "\n";
176        }
177        if ( $setexec ) {
178            print "output will be set executable\n";
179        }
180        if ( $clobber ) {
181            print "output will be overwritten - used for system modules also menu accessible\n";
182        }
183
184        if ( !$freq )
185        {
186            $notice .= "language $l: no frequency defined for assembly step " . ( $i + 1 ) . " defaulting to 'once'\n";
187            $freq = "once";
188        }
189        if ( !$output )
190        {
191            $warn .= "language $l: no output defined for assembly step " . ( $i + 1 ) . "\n";
192            next;
193        }
194
195        print "assembly freq:   $freq\n";
196        print "assembly output: $output\n";
197        print "assembly prefix: enabled\n" if $prefix;
198
199        if ( !@$inputs )
200        {
201            $warn .= "language $l: no inputs defined for assembly step " . ( $i + 1 ) . " with output $output\n";
202            $freq = "once";
203        }
204
205        my $mod_json;
206        my $rplc_mod;
207        my $ref_mod = {};
208
209        print "freq $freq\n";
210        if ( $freq eq 'menu:modules:id' )
211        {
212            $rplc_menu = start_json( $menu, $ref_menu );
213            my $mod  = $$rplc_menu{ $freq };
214            my $mod_f = $module_to_file{ $l }{ $mod };
215# this should probably be loaded once in check_files()
216            $mod_json = get_file_json_lang_specific( $mod_f, $l, 1 );
217            $rplc_mod = start_json( $mod_json, $ref_mod );
218##           $rplc_menu = rewind_json( $ref_menu );
219#            do {
220#                print "menu:modules:id " . $$rplc_menu{ $freq } . "\n";
221#            } while( $rplc_menu = next_json( $ref_menu, $freq ) );
222        }
223
224        if ( $freq eq 'config:modules:id' )
225        {
226            $rplc_menu = start_json( $config, $ref_menu );
227            my $mod  = $$rplc_menu{ 'menu:modules:id' };
228            print "mod = $mod\n";
229            my $mod_f = $module_to_file{ $l }{ $mod };
230            print "mod_f = $mod_f\n";
231# this should probably be loaded once in check_files()
232            $mod_json = get_file_json_lang_specific( $mod_f, $l, 1 );
233            $rplc_mod = start_json( $mod_json, $ref_mod );
234        }
235
236        if ( $freq eq 'configbase:modules:id' )
237        {
238            $rplc_menu = start_json( $configbase, $ref_menu );
239            my $mod  = $$rplc_menu{ 'menu:modules:id' };
240            print "mod = $mod\n";
241            my $mod_f = $module_to_file{ $l }{ $mod };
242            print "mod_f = $mod_f\n";
243# this should probably be loaded once in check_files()
244            $mod_json = get_file_json_lang_specific( $mod_f, $l, 1 );
245            $rplc_mod = start_json( $mod_json, $ref_mod );
246        }
247
248        if ( $freq =~ /^(menu:id|once)$/ )
249        {
250            $rplc_menu = start_json( $menu, $ref_menu );
251#            print Dumper( $rplc_menu );
252            my $mod  = $$rplc_menu{ 'menu:modules:id' };
253            my $mod_f = $module_to_file{ $l }{ $mod };
254# this should probably be loaded once in check_files()
255            $mod_json = get_file_json_lang_specific( $mod_f, $l, 1 );
256            $rplc_mod = start_json( $mod_json, $ref_mod );
257##           $rplc_menu = rewind_json( $ref_menu );
258#            do {
259#                print "menu:modules:id " . $$rplc_menu{ $freq } . "\n";
260#            } while( $rplc_menu = next_json( $ref_menu, $freq ) );
261        }
262
263        do {
264            my $outdata;
265            print "->-> module is now " . $$rplc_menu{ "menu:modules:id" } . "\n" if $debug_main;
266            print "->-> menu:id is now " . $$rplc_menu{ "menu:id" } . "\n" if $debug_main;
267
268            for ( my $i = 0; $i < @$inputs; ++$i )
269            {
270                while( my ( $k, $v ) = each %{$$inputs[ $i ]} )
271                {
272                    print '~'x60 . "\n" if $debug_main;
273                    print "processing: $k $v\n" if $debug_main;
274                    my $use_input = $k;
275                    if ( $freq =~ /^(menu|config|configbase):modules:id$/ )
276                    {
277# this should probably be loaded once in check_files()
278                        $mod_json = get_file_json_lang_specific( $module_to_file{ $l }{ $$rplc_menu{ 'menu:modules:id' } }, $l, 1 );
279                        $rplc_mod = start_json( $mod_json, $ref_mod );
280#                       $rplc_mod = rewind_json( $ref_mod );
281                        print "--------- input module rplc ---------\n" if $debug_srplc;
282                        while ( my ( $k, $v ) = each %$rplc_mod )
283                        {
284                            print "s/__${k}__/${v}/g\n" if $debug_srplc;
285                            $use_input =~ s/__${k}__/${v}/g;
286                        }
287                        print "--------- end input module rplc ---------\n" if $debug_srplc;
288                        if ( $prefix && $$rplc_mod{ 'prefix' } ) {
289                            $use_input = $$rplc_mod{ 'prefix' } . "-$use_input";
290                        }
291                        print "use input is $use_input\n" if $debug_main;
292                    }
293# special case:
294                    if ( $freq eq 'once' && $v eq 'fields:id' )
295                    {
296# need to loop through all modules, all fields
297                        my $use_freq = 'menu:modules:id';
298                        my $rplc_menu = start_json( $menu, $ref_menu );
299                        do {
300                            my $mod  =  $$rplc_menu{ $use_freq };
301                            my $mod_f = $module_to_file{ $l }{ $mod };
302                            print "module file $mod_f\n" if $debug_main || $debug_oncefield;
303                            my $mod_json = get_file_json_lang_specific( $mod_f, $l, 1 );
304                            my $ref_mod = {};
305                            my $rplc_mod = start_json( $mod_json, $ref_mod );
306                            do {
307                                print " field " . $$rplc_mod{ $v } . " " . $$rplc_mod{ 'fields:type' } . "\n" if $debug_main || $debug_oncefield;
308                                my $use_input = $k;
309                                while ( my ( $k, $v ) = each %$rplc_mod )
310                                {
311                                    print "s/__${k}__/${v}/g\n" if $debug_main || $debug_oncefield;
312                                    $use_input =~ s/__${k}__/${v}/g;
313                                }
314                                print "use input is now $use_input\n" if $debug_oncefield;
315                                my $f = "$gap/languages/$l/$use_input";
316                                if ( !-e $f )
317                                {
318                                    $notice .= "Skipping non-existant input $f\n" if ( $debug_main || $debug_oncefield ) && !$noticed_missing{ $f }++;
319# this 'next' should work?
320#                                    next;
321                                } else {
322                                    my $fh;
323                                    if ( ! open $fh, $f )
324                                    {
325                                        $error .= "language $l: assembly step " . ( $i + 1 ) . ": error opening input file $f $!\n";
326                                        next;
327                                    }
328                                    my @l = <$fh>;
329                                    close $fh;
330# do replacements
331                                    while ( my ( $k, $v ) = each %$rplc_directives )
332                                    {
333                                        print "directives: s/__${k}__/${v}/g\n" if $debug_srplc || $debug_oncefield;
334                                        grep s/__${k}__/${v}/g, @l;
335                                    }
336                                    while ( my ( $k, $v ) = each %$rplc_menu )
337                                    {
338                                        print "menu: s/__${k}__/${v}/g\n" if $debug_srplc || $debug_oncefield;
339                                        grep s/__${k}__/${v}/g, @l;
340                                    }
341                                    while ( my ( $k, $v ) = each %$rplc_mod )
342                                    {
343                                        print "mod: s/__${k}__/${v}/g\n" if $debug_srplc || $debug_oncefield;
344                                        grep s/__${k}__/${v}/g, @l;
345                                    }
346                                    print "get cond rplc1\n" if $debug_crplc;
347                                    for ( my $sp = 0; $sp < @l; ++$sp )
348                                    {
349                                        my @lu;
350                                        push @lu, $l[ $sp ];
351                                        my $cond_r = get_cond_replacements( \ @lu );
352                                        while ( my ( $k, $v ) = each %$cond_r )
353                                        {
354                                            if ( defined $$rplc_mod{ $k } &&
355                                                 lc( $$rplc_mod{ $k } ) ne 'false' )
356                                            {
357                                                print "1: $k => $v\n" if $debug_crplc;
358                                                my $vr = fix_up_sub_tok( $v );
359                                                grep s/__~${k}\s*\{$vr\}/$v/, @lu;
360                                            } else {
361                                                print "1: $k => $v blanked\n" if $debug_crplc;
362                                                my $vr = fix_up_sub_tok( $v );
363                                                grep s/__~${k}\s*\{$vr\}//, @lu;
364                                            }
365                                        }
366                                        print "adding to outdata------------------------------\n" if $debug_srplc || $debug_oncefield;
367                                        $outdata .= join '', @lu;
368                                    }
369                                }
370                            } while ( $rplc_mod = next_json( $ref_mod, $v ) );
371                        } while( $rplc_menu = next_json( $ref_menu, $use_freq ) );
372                        next;
373                    }
374
375                    my $f = "$gap/languages/$l/$use_input";
376                    if ( $use_input =~ /^__basedir__\// ) {
377                        my $i = $use_input;
378                        $i =~ s/^__basedir__\///;
379                        $f = "$path/$i";
380                        print "base path override $use_input resulted in $f\n";
381                    }
382                    if ( !-e $f )
383                    {
384                        $error .= "language $l: assembly step " . ( $i + 1 ) . ": missing input file $f\n";
385                        next;
386                    }
387                    my $fh;
388                    if ( ! open $fh, $f )
389                    {
390                        $error .= "language $l: assembly step " . ( $i + 1 ) . ": error opening input file $f $!\n";
391                        next;
392                    }
393                    my @l = <$fh>;
394                    close $fh;
395                    my @l_sav = @l;
396# do replacements
397                    my $r = get_replacements( \ (@l) );
398                    for ( my $i = 0; $i < @$r; ++$i )
399                    {
400                        print "$f replacement $$r[ $i ]\n" if $debug_srplc;
401                    }
402                    while ( my ( $k, $v ) = each %$rplc_directives )
403                    {
404                        print "directives: s/__${k}__/${v}/g\n" if $debug_srplc;
405                        grep s/__${k}__/${v}/g, @l;
406                    }
407
408                    if ( grep /__modulejson__/, @l ) {
409                        my $js = JSON->new;
410                        $js->canonical(1);
411                        my $enc_mod_json = $js->encode( get_file_json_lang_specific( $module_to_file{ $l }{ $$rplc_menu{ 'menu:modules:id' } }, $l, 1 ) );
412                        grep s/__modulejson__/$enc_mod_json/g, @l;
413                    }
414
415                    foreach my $sub ( keys %extra_subs ) {
416                        print "doing extra sub $sub to $extra_subs{$sub}\n" if $debug_srplc;
417                        grep s/$sub/$extra_subs{$sub}/g, @l;
418                    }
419
420                    if ( $$rplc_menu{ "menu:modules:id" } )
421                    {
422                        print "mod_f is " . $$rplc_menu{ "menu:modules:id" } . "\n" if $debug_srplc;
423                        my $mod_json = get_file_json_lang_specific( $module_to_file{ $l }{ $$rplc_menu{ "menu:modules:id" } }, $l, 1 );
424                        my $ref_mod = {};
425                        my $rplc_mod = start_json( $mod_json, $ref_mod );
426#                        while ( my ( $k, $v ) = each %$rplc_menu )
427#                        {
428#                            print "nd:menu: s/__${k}__/${v}/g\n" if $debug_srplc || $debug_oncefield;
429#                        }
430#                        while ( my ( $k, $v ) = each %$rplc_mod )
431#                        {
432#                            print "nd:mod: s/__${k}__/${v}/g\n" if $debug_srplc || $debug_oncefield;
433#                        }
434                        {
435                            print "get cond rplc2\n" if $debug_crplc;
436                            my $check_style_name = "modules/" . $$rplc_menu{ "menu:modules:id" } . ".json";
437                            undef $check_style_name if !$global_file_replace_cache_style{ $check_style_name };
438                           
439                            for ( my $sp = 0; $sp < @l; ++$sp )
440                            {
441                                my @lu;
442                                push @lu, $l[ $sp ];
443                                my $cond_r = get_cond_replacements( \ @lu );
444                                while ( my ( $k, $v ) = each %$cond_r )
445                                {
446                                    if (
447                                        ( defined $$rplc_directives{ $k } &&
448                                          lc( $$rplc_directives{ $k } ) ne 'false' ) ||
449                                        ( defined $$rplc_mod{ $k } &&
450                                          lc( $$rplc_mod{ $k } ) ne 'false' ) ||
451                                        ( defined $$rplc_menu{ $k } &&
452                                          lc( $$rplc_menu{ $k } ) ne 'false' )
453                                        )
454                                    {
455                                        print "1r1: $k => $v\n" if $debug_crplc;
456                                        my $vr = fix_up_sub_tok( $v );
457                                        grep s/__~${k}\s*\{$vr\}/$v/, @lu;
458                                    } else {
459                                        if ( $k =~ /^addstyleinfo$/ && $check_style_name ) {
460                                            print "1r2: ready to insert style $k => $v\n" if $debug_crplc;
461                                            my $v2 = $v;
462                                            $v2 =~ s/__addstyleinfo__/$global_file_replace_cache_style{ $check_style_name }/;
463                                            print "1r2b: ready to insert style $k => $v2\n" if $debug_crplc;
464                                            my $vr = fix_up_sub_tok( $v );
465                                            grep s/__~${k}\s*\{$vr\}/$v2/, @lu;
466                                        } else {
467                                            print "1b: $k => $v blanked\n" if $debug_crplc;
468                                            my $vr = fix_up_sub_tok( $v );
469                                            grep s/__~${k}\s*\{$vr\}//, @lu;
470                                        }
471                                    }
472                                }
473                                $l[ $sp ] = $lu[ 0 ];
474                            }
475                        }
476                    } else {
477                        print "get cond rplc2b\n" if $debug_crplc;
478                        for ( my $sp = 0; $sp < @l; ++$sp )
479                        {
480                            my @lu;
481                            push @lu, $l[ $sp ];
482                            my $cond_r = get_cond_replacements( \ @lu );
483                            while ( my ( $k, $v ) = each %$cond_r )
484                            {
485                                if ( ( defined $$rplc_directives{ $k } &&
486                                       lc( $$rplc_directives{ $k } ) ne 'false' ) )
487                                {
488                                    print "1: $k => $v\n" if $debug_crplc;
489                                    my $vr = fix_up_sub_tok( $v );
490                                    grep s/__~${k}\s*\{$vr\}/$v/, @lu;
491                                } else {
492                                    print "1: $k => $v blanked\n" if $debug_crplc;
493                                    my $vr = fix_up_sub_tok( $v );
494                                    grep s/__~${k}\s*\{$vr\}//, @lu;
495                                }
496                            }
497                            $l[ $sp ] = $lu[ 0 ];
498                        }
499                    }
500# is freq menu:id
501                    if ( $v eq 'menu:id' )
502                    {
503                        if ( $freq ne 'once' )
504                        {
505                            $error .= "in $k $v: menu inputs frequency of 'menu:id' requires an assembly frequency of 'once'\n";
506                            next;
507                        }
508                        print "menu loop\n" if $debug_main;
509                        my $ref_menu2 = {};
510                        my $rplc_menu2 = start_json( $menu, $ref_menu2 );
511#                       $rplc_menu2 = rewind_json( $ref_menu2 );
512                        do {
513                            @l = @l_sav;
514                            while ( my ( $k, $v ) = each %$rplc_directives )
515                            {
516                                print "s/__${k}__/${v}/g\n" if $debug_srplc;
517                                grep s/__${k}__/${v}/g, @l;
518                            }
519                            while ( my ( $k, $v ) = each %$rplc_menu2 )
520                            {
521                                if ( $k eq 'menu:icon' && $imagesinline ) {
522                                    # print "menuicon found $v\n";
523                                    $error .= "input image $v file not found\n" if !-e $v;
524                                    my $res = `identify $v | awk '{ print \$2 \"x\" \$3 }'\n`;
525                                    my ( $t, $w, $h ) = $res =~ /^([^x]+)x([^x]+)x([^x]+)$/;
526                                    $t = lc( $t );
527                                    my $b64 = `convert -geometry x50 $v - | base64 -w 0`;
528                                    $v = "data:image/$t;base64,$b64";
529                                    # print "image of $v: $v\n"
530                                }
531                                print "s/__${k}__/${v}/g\n" if $debug_srplc;
532                                grep s/__${k}__/${v}/g, @l;
533                            }
534# add conditional replacements from rplc_menu2
535                            print "get cond rplc2x\n" if $debug_crplc;
536                            for ( my $sp = 0; $sp < @l; ++$sp )
537                            {
538                                my @lu;
539                                push @lu, $l[ $sp ];
540                                my $cond_r = get_cond_replacements( \ @lu );
541                                while ( my ( $k, $v ) = each %$cond_r )
542                                {
543                                    if ( ( defined $$rplc_menu2{ $k } &&
544                                           lc( $$rplc_menu2{ $k } ) ne 'false' ) )
545                                    {
546                                        print "1: $k => $v\n" if $debug_crplc;
547                                        my $vr = fix_up_sub_tok( $v );
548                                        grep s/__~${k}\s*\{$vr\}/$v/, @lu;
549                                    } else {
550                                        print "1: $k => $v blanked\n" if $debug_crplc;
551                                        my $vr = fix_up_sub_tok( $v );
552                                        grep s/__~${k}\s*\{$vr\}//, @lu;
553                                    }
554                                }
555                                $l[ $sp ] = $lu[ 0 ];
556                            }
557                            print "adding to outdata------------------------------\n" if $debug_srplc;
558                            $outdata .= join '', @l;
559                        } while( $rplc_menu2 = next_json( $ref_menu2, $v ) );
560                    } else {
561                        if ( $v =~ /^(menu|config|configbase):modules:id$/ )
562                        {
563                            print "hello menu:modules:id\n" if $debug_main;
564                            my $ref_menu2 = {};
565                            my $rplc_menu2 = start_json( $menu, $ref_menu2 );
566                            while ( $rplc_menu2 && $$rplc_menu2{ 'menu:id' } ne $$rplc_menu{ 'menu:id' } )
567                            {
568                                $rplc_menu2 = next_json( $ref_menu2, 'menu:id' );
569                            }
570                            if ( $$rplc_menu2{ 'menu:id' } ne $$rplc_menu{ 'menu:id' } )
571                            {
572                                $error .= "menu lookup error in $l $v\n";
573                            }
574                            do {
575                                print "rplc menu:id " . $$rplc_menu2{ "menu:id" } . " " . $$rplc_menu{ 'menu:id' } . "\n" if $debug_srplc; 
576                                @l = @l_sav;
577                                while ( my ( $k, $v ) = each %$rplc_directives )
578                                {
579                                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
580                                    grep s/__${k}__/${v}/g, @l;
581                                }
582                                while ( my ( $k, $v ) = each %$rplc_menu2 )
583                                {
584                                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
585                                    grep s/__${k}__/${v}/g, @l;
586                                }
587                                print "module_to_file: " . Dumper(%module_to_file) . "\n" if $debug_srplc && 0;
588                                print "rplc_menu of menu:modules:id is " . $$rplc_menu{ 'menu:modules:id' } . "\n"  if $debug_srplc;
589                                print "rplc_menu2 of menu:modules:id is " . $$rplc_menu2{ 'menu:modules:id' } . "\n"  if $debug_srplc;
590                                my $mod_json = get_file_json_lang_specific( $module_to_file{ $l }{ $$rplc_menu2{ "menu:modules:id" } }, $l, 1 );
591                                my $ref_mod  = {};
592                                $ref_mod =start_json( $mod_json, $ref_mod );
593# add conditional replacements from the module definition
594                                print "ref_mod: " . Dumper($ref_mod) . "\n" if $debug_srplc;
595                                my $rplc_mod = {};
596# need the extra module tag to not confuse with higher level replacements
597                                while ( my ( $k, $v ) = each %$ref_mod )
598                                {
599                                    $$rplc_mod{ "module:$k" } = $v;
600                                }
601                               
602                                print "rplc_mod: " . Dumper($rplc_mod) . "\n" if $debug_srplc;
603
604                                for ( my $sp = 0; $sp < @l; ++$sp )
605                                {
606                                    my @lu;
607                                    push @lu, $l[ $sp ];
608                                    my $cond_r = get_cond_replacements( \ @lu );
609                                    while ( my ( $k, $v ) = each %$cond_r )
610                                    {
611                                        if ( ( defined $$rplc_mod{ $k } &&
612                                               lc( $$rplc_mod{ $k } ) ne 'false' ) ||
613                                             ( defined $$rplc_menu2{ $k } &&
614                                               lc( $$rplc_menu2{ $k } ) ne 'false' ) )
615                                        {
616                                            print "1mx: $k => $v\n" if $debug_crplc;
617                                            my $vr = fix_up_sub_tok( $v );
618                                            grep s/__~${k}\s*\{$vr\}/$v/, @lu;
619                                        } else {
620                                            print "1mb: $k => $v blanked\n" if $debug_crplc;
621                                            my $vr = fix_up_sub_tok( $v );
622                                            grep s/__~${k}\s*\{$vr\}//, @lu;
623                                        }
624                                    }
625                                    $l[ $sp ] = $lu[ 0 ];
626                                }
627# and finally replace again
628                                while ( my ( $k, $v ) = each %$rplc_mod )
629                                {
630                                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
631                                    grep s/__${k}__/${v}/g, @l;
632                                }
633                               
634                                print "adding to outdata------------------------------\n" if $debug_srplc;
635                                $outdata .= join '', @l;
636                                $rplc_menu2 = next_json( $ref_menu2, $v );
637                            } while ( $rplc_menu2 && 
638                                      ($freq ne 'menu:id' || $$rplc_menu2{ 'menu:id' } eq $$rplc_menu{ 'menu:id' } )
639                                      );
640                        } else {
641# todo if $freq = 'module' find specific module json and make subs (add support in genapp_util ?
642                            if ( ref( $rplc_menu ) eq 'HASH' )
643                            {
644                                while ( my ( $k, $v ) = each %$rplc_menu )
645                                {
646                                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
647                                    grep s/__${k}__/${v}/g, @l;
648                                }
649                            }
650                            if ( $freq =~ /^(menu|config|configbase):modules:id$/ )
651                            {
652                                $rplc_mod = start_json( $mod_json, $ref_mod );
653#                               $rplc_mod = rewind_json( $ref_mod );
654                                print "--------- menu/module rplc ---------\n" if $debug_srplc;
655                                while ( my ( $k, $v ) = each %$rplc_mod )
656                                {
657                                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
658                                    grep s/__${k}__/${v}/g, @l;
659                                }
660                                print "--------- end menu/module rplc ---------\n" if $debug_srplc;
661                                my $ex = $$rplc_mod{ 'executable' };
662                                print "exec $ex\n" if $debug_smain;
663                            }
664                            if ( $v eq 'fields:id' )
665                            {
666                                my $role = $k;
667                                $role =~ s/^.*\.//;
668                                print "fields:id module loop ___________ k is $k, role $role\n" if $debug_srplc;
669                               
670                                $rplc_mod = start_json( $mod_json, $ref_mod );
671#                               $rplc_mod = rewind_json( $ref_mod );
672                                do {
673                                    if ( !defined $$rplc_mod{ 'fields:role' } )
674                                    {
675                                        $warn .= "fields:role not defined in module " . $$rplc_mod{ 'moduleid' } . " " . "fields:id " . $$rplc_mod{ 'fields:id' } . "\n";
676                                    }
677                                    print "field " .  $$rplc_mod{ 'fields:id' } . " role " . $$rplc_mod{ 'fields:role' } . "\n" if $debug_srplc;
678                                    if ( $$rplc_mod{ 'fields:role' } eq $role )
679                                    {
680                                        my $use_input = $k;
681                                        while ( my ( $k, $v ) = each %$rplc_mod )
682                                        {
683                                            print "s/__${k}__/${v}/g\n" if $debug_srplc;
684                                            $use_input =~ s/__${k}__/${v}/g;
685                                        }
686                                        my $f = "$gap/languages/$l/$use_input";
687                                        print "processing role input from $f\n" if $debug_main;
688                                        if ( !-e $f )
689                                        {
690                                            $error .= "language $l: assembly step " . ( $i + 1 ) . ": missing input file $f\n";
691                                            next;
692                                        }
693                                        my $fh;
694                                        if ( ! open $fh, $f )
695                                        {
696                                            $error .= "language $l: assembly step " . ( $i + 1 ) . ": error opening input file $f $!\n";
697                                            next;
698                                        }
699                                        my @l = <$fh>;
700                                        close $fh;
701                                        while ( my ( $k, $v ) = each %$rplc_mod )
702                                        {
703                                            print "s/__${k}__/${v}/g\n" if $debug_srplc;
704                                            grep s/__${k}__/${v}/g, @l;
705                                        }
706                                        print "get cond rplc3\n" if $debug_crplc;
707                                        for ( my $sp = 0; $sp < @l; ++$sp )
708                                        {
709                                            my @lu;
710                                            push @lu, $l[ $sp ];
711                                            my $cond_r = get_cond_replacements( \ @lu );
712                                            while ( my ( $k, $v ) = each %$cond_r )
713                                            {
714                                                if ( defined $$rplc_mod{ $k } &&
715                                                     lc( $$rplc_mod{ $k } ) ne 'false' )
716                                                {
717                                                    print "2: $k => $v\n" if $debug_crplc;
718                                                    my $vr = fix_up_sub_tok( $v );
719                                                    if ( $$rplc_mod{ $k } =~ /~/ )
720                                                    {
721                                                        my @vals = split '~', $$rplc_mod{ $k };
722                                                        my $entries_per = () = $v =~ /~(\d+)/g;
723                                                        print "entries per $entries_per\n" if $debug_crplc;
724                                                        my $v_new;
725                                                        for ( my $i = 0; $i < @vals; $i += $entries_per )
726                                                        {
727                                                            my $v_this = $v;
728                                                            for ( my $j = 0; $j < $entries_per; ++$j )
729                                                            {
730                                                                $v_this =~ s/~$j/$vals[$i + $j ]/;
731                                                            }
732                                                            $v_new .= $v_this;
733                                                        }
734                                                        $v = $v_new;
735                                                        print "2b: $k => $v\n" if $debug_crplc;
736                                                    }
737                                                    grep s/__~${k}\s*\{$vr\}/$v/, @lu;
738                                                } else {
739                                                    print "2: $k => $v blanked\n" if $debug_crplc;
740                                                    my $vr = fix_up_sub_tok( $v );
741                                                    grep s/__~${k}\s*\{$vr\}//, @lu;
742                                                }
743                                            }
744                                            print "adding to outdata------------------------------\n" if $debug_srplc;
745                                            $outdata .= join '', @lu;
746                                        }
747                                    }
748                                } while( $rplc_mod = next_json( $ref_mod, $v ) );
749                            } else {
750                                $outdata .= join '', @l;
751                            }
752                        }
753                    }
754                }
755            }
756
757# write output
758
759            my $use_output = $output;
760            while ( my ( $k, $v ) = each %$rplc_directives )
761            {
762                print "s/__${k}__/${v}/g\n" if $debug_srplc;
763                $use_output =~ s/__${k}__/${v}/g;
764            }
765            if ( $freq =~ /^((menu|config|configbase):modules:id|menu:id)$/ )
766            {
767                print '-'x40 . "\n" if $debug_srplc;
768                print "menu rplcs\n" if $debug_srplc;
769                print '-'x40 . "\n" if $debug_srplc;
770                while ( my ( $k, $v ) = each %$rplc_menu )
771                {
772                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
773                    $use_output =~ s/__${k}__/${v}/g;
774                }
775
776                if ( $freq =~ /^(menu|config|configbase):modules:id$/ )
777                {
778                    while ( my ( $k, $v ) = each %$rplc_mod )
779                    {
780                        print "s/__${k}__/${v}/g\n" if $debug_srplc;
781                        $use_output =~ s/__${k}__/${v}/g;
782                    }
783                }
784                print '-'x40 . "\n" if $debug_srplc;
785                print "use output is $use_output\n" if $debug_main;
786            }
787            print '^'x20 . "use output $use_output" . '^'x20 . "\n" if $debug_main;
788
789            my $fo = "output/$l/$use_output";
790            $error .= "duplicate output for $fo\n" if $created{ $fo }++ && !$clobber;
791            {
792                my $docopy = 1;
793                if ( -e $fo ) {
794                    open my $fhi, $fo;
795                    my @l = <$fhi>;
796                    close $fhi;
797                    my $cmpdata = join '', @l;
798                    $docopy = ( $cmpdata ne $outdata );
799                }
800                if ( $docopy ) {
801                    mkdir_for_file( $fo );
802                    my $fh;
803                    if ( !open $fh, ">$fo" )
804                    {
805                        $error .= "language $l: assembly step " . ( $i + 1 ) . ": error opening output file $fo\n";
806                        next;
807                    }
808                    print $fh $outdata;
809                    close $fh;
810                    $created .= "$fo\n";
811                }
812            }
813            if ( $setexec ) {
814                my $cmd = "chmod +x $fo";
815                `$cmd`;
816            }
817            {
818                my $cmd = "chmod g+w $fo";
819                `$cmd 2>&1`;
820            }
821
822            if ( $minify eq "minify" ) {
823                my $fn = $fo;
824                $fn =~ s/\.js/.min.js/;
825#                $error .= "duplicate output for $fn\n" if $created{ $fn }++;
826                `which minify`;
827                if ( $? ) {
828                    $error .= "minify was requested but does not appear to be installed or is not in the default executable search path\n";
829                } else {
830                    my $cmd = "minify -o $fn $fo";
831                    print "$cmd\n";
832                    my $res = `$cmd 2>&1\n`;
833                    print $res;
834                    $error .= "JS minification error: $fo $res" if $res !~ /^Minification complete/;
835                    $created .= "$fn\n";
836                    my $fd = $fn;
837                    $fd =~ s/output\/$l/$gap\/languages\/$l\/add/;
838                    print "mv -f $fn $fd\n";
839                    print `mv -f $fn $fd\n`;
840                }
841            }
842            if ( $minify eq "closure" ) {
843                my $fn = $fo;
844                $fn =~ s/\.js/.min.js/;
845#                $error .= "duplicate output for $fn\n" if $created{ $fn }++;
846                `which java`;
847                if ( $? ) {
848                    $error .= "closure was requested but this requires java, which does not appear to be installed or is not in the default executable search path\n";
849                } else {
850                    my $cmd = "java -jar $gap/etc/closure_compiler.jar --js $fo --js_output_file $fn";
851                    print "$cmd\n";
852                    my $res = `$cmd 2>&1\n`;
853                    print $res;
854                    $error .= "JS closure error: $fo $res" if $res =~ /(\d+) error\(s\)/ && $1 ne "0";
855                    $created .= "$fn\n";
856                    my $fd = $fn;
857                    $fd =~ s/output\/$l/$gap\/languages\/$l\/add/;
858                    print "mv -f $fn $fd\n";
859                    print `mv -f $fn $fd\n`;
860                }
861            }
862            if ( $minify eq "copy" ) {
863                my $fn = $fo;
864                $fn =~ s/\.js/.min.js/;
865#                $error .= "duplicate output for $fn\n" if $created{ $fn }++;
866                my $cmd = "cp -f $fo $fn";
867                print "$cmd\n";
868                my $res = `$cmd 2>&1\n`;
869                print $res;
870                $created .= "$fn\n";
871                my $fd = $fn;
872                $fd =~ s/output\/$l/$gap\/languages\/$l\/add/;
873                print "mv $fn $fd\n";
874                print `mv $fn $fd\n`;
875            }
876
877            if ( $doexec ) {
878                print "doexec is '$doexec'\n";
879                if ( $doexec eq 'true' ) {
880                    my $cmd = "bash $fo";
881                    print "executing: $cmd\n";
882                    print `$cmd`;
883                }
884                if ( $doexec eq 'atend' ) {
885                    my $cmd = "cd output/$l; bash $use_output";
886                    push @post_cmds, $cmd;
887                    print "pushing $cmd to post processing commands\n";
888                }
889            }
890
891            if ( $freq eq 'config:modules:id' ||
892                 $freq eq 'configbase:modules:id' ) 
893            {
894                $rplc_menu = next_json( $ref_menu, 'menu:modules:id' );
895            } else {
896                $rplc_menu = next_json( $ref_menu, $freq ) if $freq =~ /^(menu:modules:id|menu:id)$/;
897            }
898        } while ( $freq =~ /^((menu|config|configbase):modules:id|menu:id)$/ && $rplc_menu );
899    } # end for assembly step
900    # copy over icons
901    foreach my $k ( keys %icons )
902    {
903        my $fo = "output/$l/$k";
904        $warn .= "duplicate output for $fo\n" if $created{ $fo }++;
905        my $docopy = 1;
906        if ( -e $fo ) {
907            my $cmd = "cmp $k $fo\n";
908            system( $cmd );
909            $docopy = $?;
910        }
911        if ( $docopy ) {
912            mkdir_for_file( $fo );
913            my $cmd = "cp $k $fo\n";
914            $created .= "$fo\n";
915            `$cmd`;
916        }
917    }
918    # include_additional_files
919    foreach my $k ( keys %include_additional_files ) {
920        my $fo = "output/$l/" . $include_additional_files{ $k };
921        $warn .= "duplicate output for $fo\n" if $created{ $fo }++;
922        my $docopy = 1;
923        if ( -e $fo ) {
924            my $cmd = "cmp $k $fo\n";
925            system( $cmd );
926            $docopy = $?;
927        }
928        if ( $docopy ) {
929            mkdir_for_file( $fo );
930            my $cmd = "cp $k $fo\n";
931            $created .= "$fo\n";
932            `$cmd`;
933        }
934    }
935       
936    # copy over add/*
937    if ( -d "$gap/languages/$l/add" )
938    {
939        my @add = `(cd $gap/languages/$l/add; find * -type f -follow)`;
940        grep chomp, @add;
941        foreach my $k ( @add )
942        {
943            if ( $k !~ /^\./ && $k !~ /\/\./ )
944            {
945                my $fo = "output/$l/$k";
946                $warn .= "duplicate output for $fo\n" if $created{ $fo }++;
947                my $docopy = 1;
948                if ( -e $fo ) {
949                    my $cmd = "cmp $gap/languages/$l/add/$k $fo\n";
950                    system( $cmd );
951                    $docopy = $?;
952                }
953                if ( $docopy ) {
954                    mkdir_for_file( $fo );
955                    my $cmd = "cp $gap/languages/$l/add/$k $fo\n";
956                    $created .= "$fo\n";
957                    print `$cmd`;
958                }
959            }
960        }
961    }
962    # copy over application add/*
963    if ( -d "add" )
964    {
965        my @add = `(cd add; find * -type f -follow)`;
966        grep chomp, @add;
967        foreach my $k ( @add )
968        {
969            if ( $k !~ /^\./ && $k !~ /\/\./ )
970            {
971                my $fo = "output/$l/$k";
972                $warn .= "duplicate output for $fo\n" if $created{ $fo }++;
973                my $docopy = 1;
974                if ( -e $fo ) {
975                    my $cmd = "cmp add/$k $fo\n";
976                    system( $cmd );
977                    $docopy = $?;
978                }
979                if ( $docopy ) {
980                    mkdir_for_file( $fo );
981                    my $cmd = "cp add/$k $fo\n";
982                    $created .= "$fo\n";
983                    print `$cmd`;
984                }
985            }
986        }
987    }
988    # copy over application language specific add/*
989    if ( -d "$l/add" )
990    {
991        my @add = `(cd $l/add; find * -type f -follow)`;
992        grep chomp, @add;
993        foreach my $k ( @add )
994        {
995            if ( $k !~ /^\./ && $k !~ /\/\./ )
996            {
997                my $fo = "output/$l/$k";
998                $warn .= "duplicate output for $fo\n" if $created{ $fo }++;
999                my $docopy = 1;
1000                if ( -e $fo ) {
1001                    my $cmd = "cmp $l/add/$k $fo\n";
1002                    system( $cmd );
1003                    $docopy = $?;
1004                }
1005                if ( $docopy ) {
1006                    mkdir_for_file( $fo );
1007                    my $cmd = "cp $l/add/$k $fo\n";
1008                    $created .= "$fo\n";
1009                    print `$cmd`;
1010                }
1011            }
1012        }
1013    }
1014    # run any scripts in output
1015    if ( @post_cmds ) {
1016        print '='x80 . "\n";
1017        foreach my $k ( @post_cmds ) {
1018            my $cmd = $post_cmds[ $k ];
1019            print "executing: $cmd\n";
1020            print `$cmd`;
1021        }
1022        undef @post_cmds;
1023    }
1024    if ( $$lang{ 'register' } ) {
1025        my $cmd = $$lang{ 'register' };
1026        my $res = `$cmd`;
1027        print "registering:$res\n" if $debug_main;
1028    }
1029} # end for language
1030
1031print '-'x60 . "\nNo changes.\n" . '-'x60 . "\n"      if !$created;
1032print '-'x60 . "\nCreated:\n$created" . '-'x60 . "\n" if $created;
1033print '-'x60 . "\nNotices:\n$notice" . '-'x60 . "\n"  if $notice;
1034print '-'x60 . "\nWarnings:\n$warn" . '-'x60 . "\n"   if $warn;
1035print '-'x60 . "\nErrors:\n$error" . '-'x60 . "\n"    if $error;
Note: See TracBrowser for help on using the repository browser.