source: genappalpha/bin/genapp_run.pl @ 1492

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

Further dependency inserts

  • Property svn:executable set to *
File size: 48.2 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                                if ( grep /__modulejson__/, @l ) {
578                                    my $js = JSON->new;
579                                    $js->canonical(1);
580                                    my $enc_mod_json = $js->encode( get_file_json_lang_specific( $module_to_file{ $l }{ $$rplc_menu2{ 'menu:modules:id' } }, $l, 1 ) );
581                                    grep s/__modulejson__/$enc_mod_json/g, @l;
582                                }
583                                foreach my $sub ( keys %extra_subs ) {
584                                    print "doing extra sub $sub to $extra_subs{$sub}\n" if $debug_srplc;
585                                    grep s/$sub/$extra_subs{$sub}/g, @l;
586                                }
587
588                                while ( my ( $k, $v ) = each %$rplc_directives )
589                                {
590                                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
591                                    grep s/__${k}__/${v}/g, @l;
592                                }
593                                while ( my ( $k, $v ) = each %$rplc_menu2 )
594                                {
595                                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
596                                    grep s/__${k}__/${v}/g, @l;
597                                }
598                                print "module_to_file: " . Dumper(%module_to_file) . "\n" if $debug_srplc && 0;
599                                print "rplc_menu of menu:modules:id is " . $$rplc_menu{ 'menu:modules:id' } . "\n"  if $debug_srplc;
600                                print "rplc_menu2 of menu:modules:id is " . $$rplc_menu2{ 'menu:modules:id' } . "\n"  if $debug_srplc;
601                                my $mod_json = get_file_json_lang_specific( $module_to_file{ $l }{ $$rplc_menu2{ "menu:modules:id" } }, $l, 1 );
602                                my $ref_mod  = {};
603                                $ref_mod =start_json( $mod_json, $ref_mod );
604# add conditional replacements from the module definition
605                                print "ref_mod: " . Dumper($ref_mod) . "\n" if $debug_srplc;
606                                my $rplc_mod = {};
607# need the extra module tag to not confuse with higher level replacements
608                                while ( my ( $k, $v ) = each %$ref_mod )
609                                {
610                                    $$rplc_mod{ "module:$k" } = $v;
611                                }
612                               
613                                print "rplc_mod: " . Dumper($rplc_mod) . "\n" if $debug_srplc;
614
615                                for ( my $sp = 0; $sp < @l; ++$sp )
616                                {
617                                    my @lu;
618                                    push @lu, $l[ $sp ];
619                                    my $cond_r = get_cond_replacements( \ @lu );
620                                    while ( my ( $k, $v ) = each %$cond_r )
621                                    {
622                                        if ( ( defined $$rplc_mod{ $k } &&
623                                               lc( $$rplc_mod{ $k } ) ne 'false' ) ||
624                                             ( defined $$rplc_menu2{ $k } &&
625                                               lc( $$rplc_menu2{ $k } ) ne 'false' ) )
626                                        {
627                                            print "1mx: $k => $v\n" if $debug_crplc;
628                                            my $vr = fix_up_sub_tok( $v );
629                                            grep s/__~${k}\s*\{$vr\}/$v/, @lu;
630                                        } else {
631                                            print "1mb: $k => $v blanked\n" if $debug_crplc;
632                                            my $vr = fix_up_sub_tok( $v );
633                                            grep s/__~${k}\s*\{$vr\}//, @lu;
634                                        }
635                                    }
636                                    $l[ $sp ] = $lu[ 0 ];
637                                }
638# and finally replace again
639                                while ( my ( $k, $v ) = each %$rplc_mod )
640                                {
641                                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
642                                    grep s/__${k}__/${v}/g, @l;
643                                }
644
645                                # print "outdata 3--------\n";
646                                # print join '', @l;
647                                print "adding to outdata------------------------------\n" if $debug_srplc;
648                                $outdata .= join '', @l;
649                                $rplc_menu2 = next_json( $ref_menu2, $v );
650                            } while ( $rplc_menu2 && 
651                                      ($freq ne 'menu:id' || $$rplc_menu2{ 'menu:id' } eq $$rplc_menu{ 'menu:id' } )
652                                      );
653                        } else {
654# todo if $freq = 'module' find specific module json and make subs (add support in genapp_util ?
655                            if ( ref( $rplc_menu ) eq 'HASH' )
656                            {
657                                while ( my ( $k, $v ) = each %$rplc_menu )
658                                {
659                                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
660                                    grep s/__${k}__/${v}/g, @l;
661                                }
662                            }
663                            if ( $freq =~ /^(menu|config|configbase):modules:id$/ )
664                            {
665                                $rplc_mod = start_json( $mod_json, $ref_mod );
666#                               $rplc_mod = rewind_json( $ref_mod );
667                                print "--------- menu/module rplc ---------\n" if $debug_srplc;
668                                while ( my ( $k, $v ) = each %$rplc_mod )
669                                {
670                                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
671                                    grep s/__${k}__/${v}/g, @l;
672                                }
673                                print "--------- end menu/module rplc ---------\n" if $debug_srplc;
674                                my $ex = $$rplc_mod{ 'executable' };
675                                print "exec $ex\n" if $debug_smain;
676                            }
677                            if ( $v eq 'fields:id' )
678                            {
679                                my $role = $k;
680                                $role =~ s/^.*\.//;
681                                print "fields:id module loop ___________ k is $k, role $role\n" if $debug_srplc;
682                               
683                                $rplc_mod = start_json( $mod_json, $ref_mod );
684#                               $rplc_mod = rewind_json( $ref_mod );
685                                do {
686                                    if ( !defined $$rplc_mod{ 'fields:role' } )
687                                    {
688                                        $warn .= "fields:role not defined in module " . $$rplc_mod{ 'moduleid' } . " " . "fields:id " . $$rplc_mod{ 'fields:id' } . "\n";
689                                    }
690                                    print "field " .  $$rplc_mod{ 'fields:id' } . " role " . $$rplc_mod{ 'fields:role' } . "\n" if $debug_srplc;
691                                    if ( $$rplc_mod{ 'fields:role' } eq $role )
692                                    {
693                                        my $use_input = $k;
694                                        while ( my ( $k, $v ) = each %$rplc_mod )
695                                        {
696                                            print "s/__${k}__/${v}/g\n" if $debug_srplc;
697                                            $use_input =~ s/__${k}__/${v}/g;
698                                        }
699                                        my $f = "$gap/languages/$l/$use_input";
700                                        print "processing role input from $f\n" if $debug_main;
701                                        if ( !-e $f )
702                                        {
703                                            $error .= "language $l: assembly step " . ( $i + 1 ) . ": missing input file $f\n";
704                                            next;
705                                        }
706                                        my $fh;
707                                        if ( ! open $fh, $f )
708                                        {
709                                            $error .= "language $l: assembly step " . ( $i + 1 ) . ": error opening input file $f $!\n";
710                                            next;
711                                        }
712                                        my @l = <$fh>;
713                                        close $fh;
714                                        while ( my ( $k, $v ) = each %$rplc_mod )
715                                        {
716                                            print "s/__${k}__/${v}/g\n" if $debug_srplc;
717                                            grep s/__${k}__/${v}/g, @l;
718                                        }
719                                        print "get cond rplc3\n" if $debug_crplc;
720                                        for ( my $sp = 0; $sp < @l; ++$sp )
721                                        {
722                                            my @lu;
723                                            push @lu, $l[ $sp ];
724                                            my $cond_r = get_cond_replacements( \ @lu );
725                                            while ( my ( $k, $v ) = each %$cond_r )
726                                            {
727                                                if ( defined $$rplc_mod{ $k } &&
728                                                     lc( $$rplc_mod{ $k } ) ne 'false' )
729                                                {
730                                                    print "2: $k => $v\n" if $debug_crplc;
731                                                    my $vr = fix_up_sub_tok( $v );
732                                                    if ( $$rplc_mod{ $k } =~ /~/ )
733                                                    {
734                                                        my @vals = split '~', $$rplc_mod{ $k };
735                                                        my $entries_per = () = $v =~ /~(\d+)/g;
736                                                        print "entries per $entries_per\n" if $debug_crplc;
737                                                        my $v_new;
738                                                        for ( my $i = 0; $i < @vals; $i += $entries_per )
739                                                        {
740                                                            my $v_this = $v;
741                                                            for ( my $j = 0; $j < $entries_per; ++$j )
742                                                            {
743                                                                $v_this =~ s/~$j/$vals[$i + $j ]/;
744                                                            }
745                                                            $v_new .= $v_this;
746                                                        }
747                                                        $v = $v_new;
748                                                        print "2b: $k => $v\n" if $debug_crplc;
749                                                    }
750                                                    grep s/__~${k}\s*\{$vr\}/$v/, @lu;
751                                                } else {
752                                                    print "2: $k => $v blanked\n" if $debug_crplc;
753                                                    my $vr = fix_up_sub_tok( $v );
754                                                    grep s/__~${k}\s*\{$vr\}//, @lu;
755                                                }
756                                            }
757                                            print "adding to outdata------------------------------\n" if $debug_srplc;
758                                            $outdata .= join '', @lu;
759                                        }
760                                    }
761                                } while( $rplc_mod = next_json( $ref_mod, $v ) );
762                            } else {
763                                $outdata .= join '', @l;
764                            }
765                        }
766                    }
767                }
768            }
769
770# write output
771
772            my $use_output = $output;
773            while ( my ( $k, $v ) = each %$rplc_directives )
774            {
775                print "s/__${k}__/${v}/g\n" if $debug_srplc;
776                $use_output =~ s/__${k}__/${v}/g;
777            }
778            if ( $freq =~ /^((menu|config|configbase):modules:id|menu:id)$/ )
779            {
780                print '-'x40 . "\n" if $debug_srplc;
781                print "menu rplcs\n" if $debug_srplc;
782                print '-'x40 . "\n" if $debug_srplc;
783                while ( my ( $k, $v ) = each %$rplc_menu )
784                {
785                    print "s/__${k}__/${v}/g\n" if $debug_srplc;
786                    $use_output =~ s/__${k}__/${v}/g;
787                }
788
789                if ( $freq =~ /^(menu|config|configbase):modules:id$/ )
790                {
791                    while ( my ( $k, $v ) = each %$rplc_mod )
792                    {
793                        print "s/__${k}__/${v}/g\n" if $debug_srplc;
794                        $use_output =~ s/__${k}__/${v}/g;
795                    }
796                }
797                print '-'x40 . "\n" if $debug_srplc;
798                print "use output is $use_output\n" if $debug_main;
799            }
800            print '^'x20 . "use output $use_output" . '^'x20 . "\n" if $debug_main;
801
802            my $fo = "output/$l/$use_output";
803            $error .= "duplicate output for $fo\n" if $created{ $fo }++ && !$clobber;
804            {
805                my $docopy = 1;
806                if ( -e $fo ) {
807                    open my $fhi, $fo;
808                    my @l = <$fhi>;
809                    close $fhi;
810                    my $cmpdata = join '', @l;
811                    $docopy = ( $cmpdata ne $outdata );
812                }
813                if ( $docopy ) {
814                    mkdir_for_file( $fo );
815                    my $fh;
816                    if ( !open $fh, ">$fo" )
817                    {
818                        $error .= "language $l: assembly step " . ( $i + 1 ) . ": error opening output file $fo\n";
819                        next;
820                    }
821                    print $fh $outdata;
822                    close $fh;
823                    $created .= "$fo\n";
824                }
825            }
826            if ( $setexec ) {
827                my $cmd = "chmod +x $fo";
828                `$cmd`;
829            }
830            {
831                my $cmd = "chmod g+w $fo";
832                `$cmd 2>&1`;
833            }
834
835            if ( $minify eq "minify" ) {
836                my $fn = $fo;
837                $fn =~ s/\.js/.min.js/;
838#                $error .= "duplicate output for $fn\n" if $created{ $fn }++;
839                `which minify`;
840                if ( $? ) {
841                    $error .= "minify was requested but does not appear to be installed or is not in the default executable search path\n";
842                } else {
843                    my $cmd = "minify -o $fn $fo";
844                    print "$cmd\n";
845                    my $res = `$cmd 2>&1\n`;
846                    print $res;
847                    $error .= "JS minification error: $fo $res" if $res !~ /^Minification complete/;
848                    $created .= "$fn\n";
849                    my $fd = $fn;
850                    $fd =~ s/output\/$l/$gap\/languages\/$l\/add/;
851                    print "mv -f $fn $fd\n";
852                    print `mv -f $fn $fd\n`;
853                }
854            }
855            if ( $minify eq "closure" ) {
856                my $fn = $fo;
857                $fn =~ s/\.js/.min.js/;
858#                $error .= "duplicate output for $fn\n" if $created{ $fn }++;
859                `which java`;
860                if ( $? ) {
861                    $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";
862                } else {
863                    my $cmd = "java -jar $gap/etc/closure_compiler.jar --js $fo --js_output_file $fn";
864                    print "$cmd\n";
865                    my $res = `$cmd 2>&1\n`;
866                    print $res;
867                    $error .= "JS closure error: $fo $res" if $res =~ /(\d+) error\(s\)/ && $1 ne "0";
868                    $created .= "$fn\n";
869                    my $fd = $fn;
870                    $fd =~ s/output\/$l/$gap\/languages\/$l\/add/;
871                    print "mv -f $fn $fd\n";
872                    print `mv -f $fn $fd\n`;
873                }
874            }
875            if ( $minify eq "copy" ) {
876                my $fn = $fo;
877                $fn =~ s/\.js/.min.js/;
878#                $error .= "duplicate output for $fn\n" if $created{ $fn }++;
879                my $cmd = "cp -f $fo $fn";
880                print "$cmd\n";
881                my $res = `$cmd 2>&1\n`;
882                print $res;
883                $created .= "$fn\n";
884                my $fd = $fn;
885                $fd =~ s/output\/$l/$gap\/languages\/$l\/add/;
886                print "mv $fn $fd\n";
887                print `mv $fn $fd\n`;
888            }
889
890            if ( $doexec ) {
891                print "doexec is '$doexec'\n";
892                if ( $doexec eq 'true' ) {
893                    my $cmd = "bash $fo";
894                    print "executing: $cmd\n";
895                    print `$cmd`;
896                }
897                if ( $doexec eq 'atend' ) {
898                    my $cmd = "cd output/$l; bash $use_output";
899                    push @post_cmds, $cmd;
900                    print "pushing $cmd to post processing commands\n";
901                }
902            }
903
904            if ( $freq eq 'config:modules:id' ||
905                 $freq eq 'configbase:modules:id' ) 
906            {
907                $rplc_menu = next_json( $ref_menu, 'menu:modules:id' );
908            } else {
909                $rplc_menu = next_json( $ref_menu, $freq ) if $freq =~ /^(menu:modules:id|menu:id)$/;
910            }
911        } while ( $freq =~ /^((menu|config|configbase):modules:id|menu:id)$/ && $rplc_menu );
912    } # end for assembly step
913    # copy over icons
914    foreach my $k ( keys %icons )
915    {
916        my $fo = "output/$l/$k";
917        $warn .= "duplicate output for $fo\n" if $created{ $fo }++;
918        my $docopy = 1;
919        if ( -e $fo ) {
920            my $cmd = "cmp $k $fo\n";
921            system( $cmd );
922            $docopy = $?;
923        }
924        if ( $docopy ) {
925            mkdir_for_file( $fo );
926            my $cmd = "cp $k $fo\n";
927            $created .= "$fo\n";
928            `$cmd`;
929        }
930    }
931    # include_additional_files
932    foreach my $k ( keys %include_additional_files ) {
933        my $fo = "output/$l/" . $include_additional_files{ $k };
934        $warn .= "duplicate output for $fo\n" if $created{ $fo }++;
935        my $docopy = 1;
936        if ( -e $fo ) {
937            my $cmd = "cmp $k $fo\n";
938            system( $cmd );
939            $docopy = $?;
940        }
941        if ( $docopy ) {
942            mkdir_for_file( $fo );
943            my $cmd = "cp $k $fo\n";
944            $created .= "$fo\n";
945            `$cmd`;
946        }
947    }
948       
949    # copy over add/*
950    if ( -d "$gap/languages/$l/add" )
951    {
952        my @add = `(cd $gap/languages/$l/add; find * -type f -follow)`;
953        grep chomp, @add;
954        foreach my $k ( @add )
955        {
956            if ( $k !~ /^\./ && $k !~ /\/\./ )
957            {
958                my $fo = "output/$l/$k";
959                $warn .= "duplicate output for $fo\n" if $created{ $fo }++;
960                my $docopy = 1;
961                if ( -e $fo ) {
962                    my $cmd = "cmp $gap/languages/$l/add/$k $fo\n";
963                    system( $cmd );
964                    $docopy = $?;
965                }
966                if ( $docopy ) {
967                    mkdir_for_file( $fo );
968                    my $cmd = "cp $gap/languages/$l/add/$k $fo\n";
969                    $created .= "$fo\n";
970                    print `$cmd`;
971                }
972            }
973        }
974    }
975    # copy over application add/*
976    if ( -d "add" )
977    {
978        my @add = `(cd add; find * -type f -follow)`;
979        grep chomp, @add;
980        foreach my $k ( @add )
981        {
982            if ( $k !~ /^\./ && $k !~ /\/\./ )
983            {
984                my $fo = "output/$l/$k";
985                $warn .= "duplicate output for $fo\n" if $created{ $fo }++;
986                my $docopy = 1;
987                if ( -e $fo ) {
988                    my $cmd = "cmp add/$k $fo\n";
989                    system( $cmd );
990                    $docopy = $?;
991                }
992                if ( $docopy ) {
993                    mkdir_for_file( $fo );
994                    my $cmd = "cp add/$k $fo\n";
995                    $created .= "$fo\n";
996                    print `$cmd`;
997                }
998            }
999        }
1000    }
1001    # copy over application language specific add/*
1002    if ( -d "$l/add" )
1003    {
1004        my @add = `(cd $l/add; find * -type f -follow)`;
1005        grep chomp, @add;
1006        foreach my $k ( @add )
1007        {
1008            if ( $k !~ /^\./ && $k !~ /\/\./ )
1009            {
1010                my $fo = "output/$l/$k";
1011                $warn .= "duplicate output for $fo\n" if $created{ $fo }++;
1012                my $docopy = 1;
1013                if ( -e $fo ) {
1014                    my $cmd = "cmp $l/add/$k $fo\n";
1015                    system( $cmd );
1016                    $docopy = $?;
1017                }
1018                if ( $docopy ) {
1019                    mkdir_for_file( $fo );
1020                    my $cmd = "cp $l/add/$k $fo\n";
1021                    $created .= "$fo\n";
1022                    print `$cmd`;
1023                }
1024            }
1025        }
1026    }
1027    # run any scripts in output
1028    if ( @post_cmds ) {
1029        print '='x80 . "\n";
1030        foreach my $k ( @post_cmds ) {
1031            my $cmd = $post_cmds[ $k ];
1032            print "executing: $cmd\n";
1033            print `$cmd`;
1034        }
1035        undef @post_cmds;
1036    }
1037    if ( $$lang{ 'register' } ) {
1038        my $cmd = $$lang{ 'register' };
1039        my $res = `$cmd`;
1040        print "registering:$res\n" if $debug_main;
1041    }
1042} # end for language
1043
1044print '-'x60 . "\nNo changes.\n" . '-'x60 . "\n"      if !$created;
1045print '-'x60 . "\nCreated:\n$created" . '-'x60 . "\n" if $created;
1046print '-'x60 . "\nNotices:\n$notice" . '-'x60 . "\n"  if $notice;
1047print '-'x60 . "\nWarnings:\n$warn" . '-'x60 . "\n"   if $warn;
1048print '-'x60 . "\nErrors:\n$error" . '-'x60 . "\n"    if $error;
Note: See TracBrowser for help on using the repository browser.