auto/MkSrc/Create.pm

   1 # This file is part of The New Aspell
   2 # Copyright (C) 2001-2002 by Kevin Atkinson under the GNU LGPL
   3 # license version 2.0 or 2.1.  You should have received a copy of the
   4 # LGPL license along with this library if you did not you can find it
   5 # at http://www.gnu.org/.
   6
   7 package MkSrc::Create;
   8
   9 BEGIN {
  10   use Exporter;
  11   our @ISA = qw(Exporter);
  12   our @EXPORT = qw(create_cc_file create_file);
  13 }
  14
  15 use strict;
  16 use warnings;
  17 no warnings qw(uninitialized);
  18 no locale;
  19
  20 use MkSrc::Util;
  21 use MkSrc::Info;
  22
  23 =head1 MKSrc::Create
  24
  25 =over
  26
  27 =item create_cc_file PARMS
  28
  29 Create a source file.
  30
  31   Required Parms: type, dir, name, data
  32    Boolean Parms: header, cxx
  33   Optional Parms: namespace (required if cxx), pre_ext, accum
  34
  35 =item create_file FILENAME DATA
  36
  37 Writes DATA to FILENAME but only if DATA differs from the content of
  38 the file and the string:
  39
  40     Automatically generated file.
  41
  42 is present in the existing file if it already exists.
  43
  44 =back
  45
  46 =cut
  47
  48 sub create_cc_file ( % );
  49
  50 sub create_file ( $ $ );
  51
  52 sub create_cc_file ( % )  {
  53   my (%p) = @_;
  54   $p{name} = $p{data}{name} unless exists $p{name};
  55   $p{ext} = $p{cxx} ? ($p{header} ? 'hpp' : 'cpp') : 'h';
  56   my $body;
  57   my %accum = exists $p{accum} ? (%{$p{accum}}) : ();
  58   foreach my $d (@{$p{data}{data}}) {
  59     next unless exists $info{$d->{type}}{proc}{$p{type}};
  60     $body .= $info{$d->{type}}{proc}{$p{type}}->($d, \%accum);
  61   }
  62   return unless length($body) > 0;
  63   my $file = <<'---';
  64 /* Automatically generated file.  Do not edit directly. */
  65
  66 /* This file is part of The New Aspell
  67  * Copyright (C) 2001-2002 by Kevin Atkinson under the GNU LGPL
  68  * license version 2.0 or 2.1.  You should have received a copy of the
  69  * LGPL license along with this library if you did not you can find it
  70  * at http://www.gnu.org/.                                              */
  71
  72 ---
  73   my $hm = "ASPELL_". to_upper($p{name})."__".to_upper($p{ext});
  74   $file .= "#ifndef $hm\n#define $hm\n\n" if $p{header};
  75   $file .= "#include \"aspell.h\"\n" if $p{type} eq 'cxx';
  76   $file .= "#include \"settings.h\"\n" if $p{type} eq 'native_impl' && $p{name} eq 'errors';
  77   $file .= "#include \"gettext.h\"\n" if $p{type} eq 'native_impl' && $p{name} eq 'errors';
  78   $file .= cmap {"#include \"".to_lower($_).".hpp\"\n"} sort keys %{$accum{headers}};
  79   $file .= "#ifdef __cplusplus\nextern \"C\" {\n#endif\n" if $p{header} && !$p{cxx};
  80   $file .= "\nnamespace $p{namespace} {\n\n" if $p{cxx};
  81   if (defined $info{forward}{proc}{$p{type}}) {
  82     my @types = sort {$a->{name} cmp $b->{name}} (values %{$accum{types}});
  83     $file .= cmap {$info{forward}{proc}{$p{type}}->($_)} @types;
  84   }
  85   $file .= "\n";
  86   $file .= $body;
  87   $file .= "\n\n}\n\n" if $p{cxx};
  88   $file .= "#ifdef __cplusplus\n}\n#endif\n" if $p{header} && !$p{cxx};
  89   $file .= "#endif /* $hm */\n" if $p{header};
  90   create_file $p{dir}.'/'.to_lower($p{name}).$p{pre_ext}.'.'.$p{ext}, $file;
  91 }
  92
  93 sub create_file ( $ $ ) {
  94   my ($filename, $to_write) = @_;
  95   local $/ = undef;
  96   my $existing = '';
  97   open F,"../$filename" and $existing=<F>;
  98   if ($to_write eq $existing) {
  99     print "File \"$filename\" unchanged.\n";
 100   } elsif (length $existing > 0 && $existing !~ /Automatically generated file\./) {
 101     print "Will not write over \"$filename\".\n";
 102   } else {
 103     print "Creating \"$filename\".\n";
 104     open F, ">../$filename" or die;
 105     print F $to_write;
 106   }
 107 }
 108
 109 1;