waste/artemus.pl

   1 ###########################################
   2 #
   3 # Artemus main processing function
   4 #
   5 ###########################################
   6 # -*- Mode: Perl
   7
   8 use locale;
   9
  10 sub artemus
  11 {
  12         my ($data,%opts)=@_;
  13         my ($vars,$inv_vars,$funcs);
  14
  15         # abort flag not set
  16         $artemus_abort=0;
  17
  18         $vars=$opts{'vars'};
  19         $funcs=$opts{'funcs'};
  20
  21         # special values:
  22         # {-\n}, substitutes as \n
  23         $vars->{"\\n"}||="\n";
  24
  25         # special functions
  26         $funcs->{"localtime"}||=sub { scalar(localtime) };
  27         $funcs->{"if"}||=sub { $_[0] ? return($_[1]) : return("") };
  28         $funcs->{"ifelse"}||=sub { $_[0] ? return($_[1]) : return($_[2]) };
  29
  30         $data=artemus_do(undef,$data, %opts);
  31 }
  32
  33
  34 sub artemus_do
  35 {
  36         my ($template,$data,%opts)=@_;
  37         my ($vars,$inv_vars,$funcs);
  38         my ($unresolved,$cache);
  39
  40         # test if the template includes cache info
  41         if($data =~ s/{-\\CACHE\|([^}]*)}//)
  42         {
  43                 if($template and $opts{'cache_path'})
  44                 {
  45                         $cache=$1;
  46                         my ($c)=$opts{'cache_path'};
  47
  48                         if(-r "$c/$template" and
  49                            -M "$c/$template" < $cache)
  50                         {
  51                                 open F, "$c/$template";
  52                                 flock F, 1;
  53                                 $data=join("",<F>);
  54                                 close F;
  55
  56                                 return($data);
  57                         }
  58                 }
  59         }
  60
  61         # strip POD documentation
  62         if($data =~ /=cut/ and not $opts{'contains_pod'})
  63         {
  64                 my (@d);
  65
  66                 foreach (split("\n",$data))
  67                 {
  68                         push(@d, $_) unless(/^=/ .. /^=cut/);
  69                 }
  70
  71                 $data=join("\n",@d);
  72         }
  73
  74         # make hashes comfortable
  75         $vars=$opts{'vars'};
  76         $inv_vars=$opts{'inv-vars'};
  77         $funcs=$opts{'funcs'};
  78         $unresolved=$opts{'unresolved'};
  79
  80         # if defined, substitute the paragraphs
  81         # with the paragraph separator
  82         if($opts{'paragraph-separator'})
  83         {
  84                 $data =~ s/\n\n/\n$opts{'paragraph-separator'}\n/g;
  85         }
  86
  87         # concat special variables BEGIN & END
  88         $data = $vars->{"\\BEGIN"} . $data . $vars->{"\\END"};
  89
  90         # inverse substitutions
  91         for my $i (keys(%$inv_vars))
  92         {
  93                 next if $inv_vars->{$i} =~ /\$/;
  94                 next if $i =~ /^\-/;
  95                 $data =~ s/\b($i)\b/\{\-$1\}/g;
  96         }
  97
  98         # main function, variable and include substitutions
  99         while($data =~ /{-([^}{]*)}/s)
 100         {
 101                 my ($found)=$1;
 102                 my ($key,@params,$text,$n);
 103
 104                 ($key,@params)=split(/\|/,$found);
 105
 106                 # exclude dangerous keys
 107                 unless($key =~ /^[-\\\w_ \.]+$/)
 108                 {
 109                         $text=$key;
 110                 }
 111
 112                 # is it a variable?
 113                 elsif(defined $vars->{$key})
 114                 {
 115                         $text=$vars->{$key};
 116
 117                         for($n=0;$text =~ /\$$n/;$n++)
 118                         {
 119                                 $text =~ s/\$$n/$params[$n]/g;
 120                         }
 121                 }
 122
 123                 # is it a function?
 124                 elsif(defined $funcs->{$key})
 125                 {
 126                         my ($func);
 127
 128                         $func=$funcs->{$key};
 129                         $text=&$func(@params);
 130
 131                         # functions can abort further execution
 132                         last if $artemus_abort;
 133                 }
 134                 # is it an include?
 135                 elsif($opts{'include-path'})
 136                 {
 137                         foreach my $p (split(/:/,$opts{'include-path'}))
 138                         {
 139                                 if(open(INC, "$p/$key"))
 140                                 {
 141                                         $text=join("",<INC>);
 142                                         close INC;
 143
 144                                         for($n=0;$text =~ /\$$n/;$n++)
 145                                         {
 146                                                 $text =~ s/\$$n/$params[$n]/g;
 147                                         }
 148
 149                                         last;
 150                                 }
 151                         }
 152                 }
 153
 154                 unless(defined $text)
 155                 {
 156 #                        print STDERR "unresolved: '$found'\n" if not $quiet;
 157                         push(@$unresolved,$found);
 158                         $text=$found;
 159                 }
 160
 161                 # do the recursivity
 162                 $text=artemus_do($key,$text,%opts);
 163
 164                 # make the substitution
 165                 $data =~ s/{-\Q$found\E}/$text/;
 166         }
 167
 168         # finally, convert end of lines if necessary
 169         $data =~ s/\n/\r\n/g if($opts{'use-cr-lf'});
 170
 171         # if the template included cache info,
 172         # store the result there
 173         if($cache)
 174         {
 175                 open F, ">".$opts{'cache_path'}."/".$template;
 176                 flock F,2;
 177                 print F $data;
 178                 close F;
 179         }
 180
 181         return($data);
 182 }
 183
 184
 185 1;