waste/artemus1

   1 #!/usr/bin/perl
   2
   3 =pod
   4
   5 =head1 NAME
   6
   7 artemus - Programa de sustitución de texto mediante templates (moldes).
   8
   9 =head1 SYNOPSIS
  10
  11  artemus [-i|--input=<fichero origen>]
  12          [-o|--output=<fichero destino>]
  13          [-d|--template_dir=<directorio>]
  14          [-s|--start_mark=<marca inicio de comentario>]
  15          [-e|--end_mark=<marca fin de comentario>]
  16          [-h|-help]
  17
  18  artemus [-M|--dep] <fichero(s)>
  19
  20 =head1 DESCRIPTION
  21
  22 Pendiente.
  23
  24 =head1 AUTHOR
  25
  26         Angel Ortega
  27         angel@triptico.com
  28
  29 =cut
  30
  31 ########################################
  32 #       Disposiciones iniciales y
  33 #       módulos requeridos
  34 ########################################
  35
  36 use Getopt::Long;
  37
  38
  39 ########################################
  40 #       Variables globales
  41 ########################################
  42
  43 # Código de salida
  44 $ExitCode = 0;
  45
  46 # ID del programa
  47 $prog_id="artemus 1.04";
  48
  49 # directorio de templates
  50 $templ_dir="./templates";
  51
  52 # hash de templates
  53 %templates={};
  54
  55 # Marcas en los ficheros
  56 $start_mark="<!-- ";
  57 $mid_mark="#artemus ";
  58 $end_mark=" -->";
  59 $mark="";
  60
  61 # fichero de entrada
  62 $org="";
  63
  64 # fichero de salida
  65 $des="";
  66
  67 # ayuda
  68 $help=0;
  69
  70 # Variables generales
  71 %vars={};
  72
  73 # generar dependencias
  74 $dep=0;
  75
  76
  77 ########################################
  78 #       Punto de entrada al programa
  79 ########################################
  80
  81 if(!GetOptions( "i|input=s"             =>      \$org,
  82                 "o|output=s"            =>      \$des,
  83                 "d|template_dir=s"      =>      \$templ_dir,
  84                 "s|start_mark=s"        =>      \$start_mark,
  85                 "e|end_mark=s"          =>      \$end_mark,
  86                 "h|help"                =>      \$help,
  87                 "M|MM|dep"              =>      \$dep)
  88
  89                 or $help)
  90 {
  91         system("perldoc $0");
  92         exit(1);
  93 }
  94
  95
  96 # Crea la marca de identificación
  97 $mark=$start_mark . $mid_mark;
  98
  99 read_variables();
 100
 101 read_templates() or die "Error leyendo templates $!";
 102
 103 unless($dep)
 104 {
 105         process($org, $des);
 106 }
 107 else
 108 {
 109         foreach $i (@ARGV)
 110         {
 111                 process($i, undef);
 112         }
 113 }
 114
 115
 116 ########################################
 117 #       Punto de salida del programa
 118 ########################################
 119
 120 exit ($ExitCode);
 121
 122
 123 ########################################
 124 #       Métodos y funciones públicas
 125 ########################################
 126
 127
 128 sub read_variables
 129 # Lee las variables
 130 {
 131         my ($var,$value);
 132
 133         return(undef) unless open(F,"$templ_dir/VARS");
 134
 135         while(<F>)
 136         {
 137                 chop;
 138
 139                 unless(/^#/ or /^$/)
 140                 {
 141                         ($var,$value)=split("=",$_,2);
 142
 143                         $vars{"\\\$".$var}=$value;
 144                 }
 145         }
 146
 147         close F;
 148
 149         return(1);
 150 }
 151
 152
 153 sub read_templates
 154 # Lee los templates del directorio
 155 {
 156         # Abre el directorio
 157         return(undef) unless opendir(DIR, $templ_dir);
 158
 159         while($file=readdir(DIR))
 160         {
 161                 if(-f $templ_dir."/".$file)
 162                 {
 163                         open(F,$templ_dir."/".$file) or return(undef);
 164
 165                         while(<F>)
 166                         {
 167                                 $templates{$file}.=$_;
 168                         }
 169
 170                         close(F);
 171                 }
 172         }
 173
 174         closedir(DIR);
 175
 176         return(1);
 177 }
 178
 179
 180 sub process
 181 # procesa origen y destino
 182 {
 183         my ($org,$des)=@_;
 184         my ($template,$params);
 185         my ($t,$n,$c,$field,$value);
 186         my ($i,$o,@d,$org2);
 187         my ($base_rel);
 188
 189         if($org)
 190         {
 191                 # calcula base_rel
 192                 $t=$org;
 193                 while($c=chop($t))
 194                 {
 195                         $n++ if $c eq "/";
 196                 }
 197
 198                 while($n)
 199                 {
 200                         $base_rel.="../";
 201                         $n--;
 202                 }
 203
 204                 $org2=$org;
 205
 206                 if($dep)
 207                 {
 208                         $org2 =~ s/\.[a-z]*$/\.src/g;
 209                 }
 210
 211                 open(ORG,$org2) or die "Imposible abrir $org2: $!";
 212                 $i=\*ORG;
 213         }
 214         else
 215         {
 216                 $i=\*STDIN;
 217         }
 218
 219         if($des)
 220         {
 221                 open(DES,">".$des) or die "Imposible crear $des: $!";
 222                 $o=\*DES;
 223         }
 224         else
 225         {
 226                 $o=\*STDOUT;
 227         }
 228
 229         $vars{"\\\$base_rel"}=$base_rel;
 230         $vars{"\\\$/"}=$base_rel;
 231
 232         print $o "$start_mark Built with $prog_id Angel Ortega 1999 $end_mark\n" unless($dep);
 233         print $o "<meta name='generator' content='$prog_id'>\n\n";
 234
 235         @d=();
 236
 237         while(<$i>)
 238         {
 239                 if(/^\Q$mark\E/)
 240                 {
 241                         chop;
 242
 243                         # quita la marca inicial
 244                         s/\Q$mark\E//g;
 245
 246                         # y la final
 247                         s/\Q$end_mark\E//g;
 248
 249                         # recoge el template y los parámetros
 250                         ($template,$params)=split(" ",$_,2);
 251
 252                         # almacena en la lista de dependencias
 253                         # (si no está ya)
 254                         $t=$templ_dir."/".$template;
 255
 256                         push(@d,$t) unless grep(/\Q$t\E/,@d);
 257
 258                         $t=$templates{$template} or
 259                                 die "Template $template inexistente";
 260
 261                         # recorre los parámetros haciendo
 262                         # las sustituciones
 263                         while(($field,$params)=split("=",$params,2))
 264                         {
 265                                 $field="\\\$".$field;
 266
 267                                 if($params =~ /^"/)
 268                                 {
 269                                         $params =~ s/^"//;
 270
 271                                         # valor entre comillas
 272                                         ($value,$params)=split(/"/,$params,2);
 273
 274                                         # extrae posibles espacios
 275                                         $params =~ s/^ //;
 276                                 }
 277                                 else
 278                                 {
 279                                         # valor delimitado por espacio
 280                                         ($value,$params)=split(" ",$params,2);
 281                                 }
 282
 283                                 # sustituye
 284                                 $t =~ s/$field/$value/g;
 285                         }
 286                 }
 287                 else
 288                 {
 289                         $t=$_;
 290                 }
 291
 292                 # sustituciones especiales
 293
 294                 $now=scalar localtime;
 295                 $t =~ s/\$date/$now/g;
 296
 297                 # sustitución de variables globales
 298
 299                 foreach $i (keys %vars)
 300                 {
 301                         $t =~ s/$i/$vars{$i}/g;
 302                 }
 303
 304                 print $o $t unless($dep);
 305         }
 306
 307         print $o "$org: $org2 @d\n" if($dep);
 308
 309         close(ORG);
 310         close(DES);
 311 }
 312
 313
 314 ###########  Fin del programa ############