source: LMDZ5/branches/testing/tools/fcm/lib/Fcm/SrcPackage.pm @ 5444

Last change on this file since 5444 was 1665, checked in by Laurent Fairhead, 12 years ago

Version testing basée sur la r1628

http://lmdz.lmd.jussieu.fr/utilisateurs/distribution-du-modele/versions-intermediaires

Testing release based on r1628
File size: 25.4 KB
Line 
1#!/usr/bin/perl
2# ------------------------------------------------------------------------------
3# NAME
4#   Fcm::SrcPackage
5#
6# DESCRIPTION
7#   This is a class to process a source directory package. It uses the
8#   supplied inheritance hierarchy to obtain a list of source files of this
9#   package.
10#
11# COPYRIGHT
12#   (C) Crown copyright Met Office. All rights reserved.
13#   For further details please refer to the file COPYRIGHT.txt
14#   which you should have received as part of this distribution.
15# ------------------------------------------------------------------------------
16
17package Fcm::SrcPackage;
18
19# Standard pragma
20use strict;
21use warnings;
22
23# Standard modules
24use Carp;
25use File::Spec::Functions;
26use File::Basename;
27use File::Path;
28
29# FCM component modules
30use Fcm::Util;
31use Fcm::SrcFile;
32
33# ------------------------------------------------------------------------------
34# SYNOPSIS
35#   $package = Fcm::SrcPackage->new (
36#     CONFIG     => $config,
37#     NAME       => $name,
38#     CURRENT    => $current,
39#     REQUIREPP  => $requirepp,
40#     NEWPP      => $newpp,
41#     SEARCHPATH => \@path,
42#   );
43#
44# DESCRIPTION
45#   This method constructs a new instance of the Fcm::SrcPackage class.
46#
47# ARGUMENTS
48#   CONFIG     - reference to a Fcm::Config instance
49#   NAME       - name of the source directory package
50#   CURRENT    - package declared in current build?
51#   REQUIREPP  - require pre-processing?
52#   NEWPP      - pre-process option has changed?
53#   SEARCHPATH - search path of files in the source package
54# ------------------------------------------------------------------------------
55
56sub new {
57  my $this  = shift;
58  my %args  = @_;
59  my $class = ref $this || $this;
60
61  my $self  = {
62    CONFIG     => exists $args{CONFIG}     ? $args{CONFIG}     : &main::cfg,
63    NAME       => exists $args{NAME}       ? $args{NAME}       : undef,
64    CURRENT    => exists $args{CURRENT}    ? $args{CURRENT}    : undef,
65    REQUIREPP  => exists $args{REQUIREPP}  ? $args{REQUIREPP}  : undef,
66    NEWPP      => exists $args{NEWPP}      ? $args{NEWPP}      : undef,
67    SEARCHPATH => exists $args{SEARCHPATH} ? $args{SEARCHPATH} : [],
68
69    # Reference to Fcm::CfgFile, source package configuration file
70    CFG       => undef,
71
72    # References to Fcm::SrcFile, list of source files
73    SRCFILE   => [],
74  };
75
76  bless $self, $class;
77  return $self;
78}
79
80# ------------------------------------------------------------------------------
81# SYNOPSIS
82#   $config = $package->config;
83#
84# DESCRIPTION
85#   This method returns a reference to the Fcm::Config instance.
86# ------------------------------------------------------------------------------
87
88sub config {
89  my $self = shift;
90
91  return $self->{CONFIG};
92}
93
94# ------------------------------------------------------------------------------
95# SYNOPSIS
96#   $name = $package->name;
97#   $package->name ($name);
98#
99# DESCRIPTION
100#   This method returns the name of this package. If an argument is specified,
101#   the name is set to the value of the argument.
102# ------------------------------------------------------------------------------
103
104sub name {
105  my $self = shift;
106
107  if (@_) {
108    $self->{NAME} = shift;
109  }
110
111  return $self->{NAME};
112}
113
114# ------------------------------------------------------------------------------
115# SYNOPSIS
116#   $flag = $package->current;
117#   $package->current ($flag);
118#
119# DESCRIPTION
120#   This method returns the "current" flag of the source package. If an
121#   argument is specified, the flag is set to the value of the argument.
122# ------------------------------------------------------------------------------
123
124sub current {
125  my $self = shift;
126
127  if (@_) {
128    $self->{CURRENT} = shift;
129  }
130
131  return $self->{CURRENT};
132}
133
134# ------------------------------------------------------------------------------
135# SYNOPSIS
136#   $flag = $package->requirepp;
137#   $package->requirepp ($flag);
138#
139# DESCRIPTION
140#   This method returns the "require PP" flag of the source package. If an
141#   argument is specified, the flag is set to the value of the argument.
142# ------------------------------------------------------------------------------
143
144sub requirepp {
145  my $self = shift;
146
147  if (@_) {
148    $self->{REQUIREPP} = shift;
149  }
150
151  return $self->{REQUIREPP};
152}
153
154# ------------------------------------------------------------------------------
155# SYNOPSIS
156#   $flag = $package->newpp;
157#   $package->newpp ($flag);
158#
159# DESCRIPTION
160#   This method returns the flag to denote whether pre-processor option for
161#   this source package has changed. If an argument is specified, the flag is
162#   set to the value of the argument.
163# ------------------------------------------------------------------------------
164
165sub newpp {
166  my $self = shift;
167
168  if (@_) {
169    $self->{NEWPP} = shift;
170  }
171
172  return $self->{NEWPP};
173}
174
175# ------------------------------------------------------------------------------
176# SYNOPSIS
177#   $cfgfile = $package->cfg;
178#   $package->cfg ($cfgfile);
179#
180# DESCRIPTION
181#   This method returns a reference to a Fcm::CfgFile instance for the source
182#   package configuration file. If an argument is specified, the reference is
183#   set to the value of the argument.
184# ------------------------------------------------------------------------------
185
186sub cfg {
187  my $self = shift;
188
189  if (@_) {
190    $self->{CFG} = $_[0];
191  }
192
193  return $self->{CFG};
194}
195
196# ------------------------------------------------------------------------------
197# SYNOPSIS
198#   @path = $package->searchpath;
199#   $package->searchpath (@path);
200#
201# DESCRIPTION
202#   This method returns the source file search path associated with this
203#   source package in the current build. If arguments are specified, the
204#   search path is replaced by the array in the argument list.
205# ------------------------------------------------------------------------------
206
207sub searchpath {
208  my $self = shift;
209
210  @{ $self->{SEARCHPATH} } = @_ if @_; 
211
212  return @{ $self->{SEARCHPATH} };
213}
214
215# ------------------------------------------------------------------------------
216# SYNOPSIS
217#   @path = $package->ppsearchpath;
218#
219# DESCRIPTION
220#   This method returns the pre-processed source file search path associated
221#   with this source package in the current build.
222# ------------------------------------------------------------------------------
223
224sub ppsearchpath {
225  my $self = shift;
226
227  my @path = ();
228  my @name = split /__/, $self->name;
229
230  for my $ppsrcdir (@{ $self->config->setting (qw/PATH PPSRC/) }) {
231    push @path, catfile ($ppsrcdir, @name);
232  }
233
234  return @path;
235}
236
237# ------------------------------------------------------------------------------
238# SYNOPSIS
239#   $base = $package->flagsbase ($flag);
240#
241# DESCRIPTION
242#   Returns the base name of a flags-file, determined by $flag.
243# ------------------------------------------------------------------------------
244
245sub flagsbase {
246  my ($self, $flag) = @_;
247
248  return join ('__', ($flag, $self->name)) .
249         $self->config->setting (qw/OUTFILE_EXT FLAGS/);
250}
251
252# ------------------------------------------------------------------------------
253# SYNOPSIS
254#   @srcfile = $package->srcfile;
255#
256# DESCRIPTION
257#   This method returns a list of references to Fcm::SrcFile instances
258#   associated with this package.
259# ------------------------------------------------------------------------------
260
261sub srcfile {
262  my $self = shift;
263
264  return @{ $self->{SRCFILE} };
265}
266
267# ------------------------------------------------------------------------------
268# SYNOPSIS
269#   $package->update_file_info ();
270#
271# DESCRIPTION
272#   This method updates the source file information of this package. Please
273#   note that information is only updated if the cache file for this package
274#   does not exist. For a package declared in the current build, the
275#   information is also updated if the cache file is out of date.
276# ------------------------------------------------------------------------------
277
278sub update_file_info {
279  my $self      = shift;
280
281  # Check if the cache file exists and up to date
282  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
283  my $cachefile = find_file_in_path ($self->_cache_basename, \@cachepath);
284
285  my $uptodate  = $cachefile ? 1 : 0;
286  if ($uptodate and $self->{CURRENT}) {
287    # Is cache file up to date compared with directory?
288    $uptodate = (stat $cachefile) [9] > (stat $self->{SEARCHPATH}[0]) [9];
289
290    # Is cache file up to date compared with each file?
291    if ($uptodate) {
292      my $dir = $self->{SEARCHPATH}[0];
293
294      if (opendir DIR, $dir) {
295        my @files = map {catfile $dir, $_} grep {!/^\.\.?/} readdir 'DIR';
296        closedir DIR;
297        $uptodate = (grep {(stat $cachefile) [9] > (stat) [9]} @files) ? 1 : 0;
298      }
299    }
300  }
301
302  # Read package source file information if it appears to be up to date
303  $uptodate = $self->_read_file_list_cache ($cachefile) if ($uptodate);
304
305  # Update package source file information if necessary
306  if (not $uptodate) {
307    # Get list of files by searching through the search path
308    my @files = ();
309    for my $dir (@{ $self->{SEARCHPATH} }) {
310      opendir DIR, $dir;
311      while (my $base = readdir 'DIR') {
312        next if $base =~ /^\./;
313
314        my $file = catfile $dir, $base;
315        next if -d $file;
316
317        push @files, $file unless grep {basename ($_) eq $base} @files;
318      }
319      closedir DIR;
320    }
321
322    # Declare new instances of source file objects
323    my @srcfile = ();
324    for my $file (@files) {
325      if (basename ($file) eq $self->config->setting (qw/CFG_NAME SRCPACKAGE/)) {
326        $self->{CFG} = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
327
328      } else {
329        my $srcfile = Fcm::SrcFile->new (
330          CONFIG     => $self->config,
331          SRC        => $file,
332          SRCPACKAGE => $self,
333        );
334
335        # Determine source file types
336        $srcfile->determine_type;
337
338        # Record files of known types
339        push @srcfile, $srcfile;
340      }
341    }
342
343    # Set each SRCFILE to reference the source file instances
344    $self->{SRCFILE} = \@srcfile;
345
346    # Decipher configuration file if necessary
347    $self->_decipher_cfg if $self->cfg;
348
349    # Write to a new cache file
350    $self->_update_file_list_cache ();
351
352    # Source package info updated. Make sure the "current" flag is set to true
353    $self->current (1);
354  }
355
356  return;
357}
358
359# ------------------------------------------------------------------------------
360# SYNOPSIS
361#   $up_to_date = $self->_read_file_list_cache ($file);
362#
363# DESCRIPTION
364#   This internal method reads the cache $file of this package and assigns the
365#   information to the SRCFILE list. It returns true if the cache appears to
366#   be up to date.
367# ------------------------------------------------------------------------------
368
369sub _read_file_list_cache {
370  my $self = shift;
371  my $file = shift;
372
373  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
374
375  # Read from config file
376  $cfg->read_cfg;
377  my @lines = $cfg->lines;
378
379  my %filetype = ();
380  my $uptodate = 1;
381  for my $line (@lines) {
382    next unless $line->{LABEL};
383
384    # On package declared in the current build, check that file is not deleted
385    if (not -f $line->{LABEL}) {
386      $uptodate = 0;
387      last;
388    }
389
390    $filetype{$line->{LABEL}} = $line->{VALUE};
391  }
392
393  # Assign to SRCFILE list if cache file is up to date
394  if ($uptodate) {
395    my @srcfiles = ();
396
397    for my $file (sort keys %filetype) {
398      if ($filetype{$file} eq 'SRCPACKAGECFG') {
399        $self->{CFG} = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
400
401      } else {
402        my $srcfile = Fcm::SrcFile->new (
403          CONFIG     => $self->config,
404          SRC        => $file,
405          TYPE       => $filetype{$file},
406          SRCPACKAGE => $self,
407        );
408
409        push @srcfiles, $srcfile;
410      }
411    }
412
413    $self->{SRCFILE} = [@srcfiles];
414
415    $self->_decipher_cfg if $self->cfg;
416  }
417
418  return $uptodate;
419}
420
421# ------------------------------------------------------------------------------
422# SYNOPSIS
423#   $self->_update_file_list_cache (\@cachepath);
424#
425# DESCRIPTION
426#   This internal method updates the cache file of this package by writing
427#   current SRCFILE information to it. The argument @cachepath must be the
428#   search path of the build cache directory.
429# ------------------------------------------------------------------------------
430
431sub _update_file_list_cache {
432  my $self      = shift;
433  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
434
435  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
436
437  if ($self->{CFG}) {
438    $cfg->add_line (LABEL => $self->cfg->src, VALUE => 'SRCPACKAGECFG')
439  }
440
441  for my $file (@{ $self->{SRCFILE} }) {
442    $cfg->add_line (LABEL => $file->src, VALUE => $file->type);
443  }
444
445  my $cachefile = catfile $cachepath[0], $self->_cache_basename;
446  $cfg->print_cfg ($cachefile);
447
448  return;
449}
450
451# ------------------------------------------------------------------------------
452# SYNOPSIS
453#   $basename = $self->_cache_basename ($type);
454#
455# DESCRIPTION
456#   This internal method returns the basename of a cache file for this
457#   package. If no argument is specified, it returns the package file list
458#   cache name. Otherwise, it returns the package file dependency cache name.
459# ------------------------------------------------------------------------------
460
461sub _cache_basename {
462  my $self = shift;
463  my $type = $_[0] ? $_[0] : 'PCKFILE';
464
465  return $self->{NAME} . $self->config->setting ('CACHE', $type);
466}
467
468# ------------------------------------------------------------------------------
469# SYNOPSIS
470#   $self->_decipher_cfg ();
471#
472# DESCRIPTION
473#   This internal method deciphers the CFG file associated with this source
474#   package.
475# ------------------------------------------------------------------------------
476
477sub _decipher_cfg {
478  my $self = shift;
479
480  $self->cfg->read_cfg;
481  my @lines = $self->cfg->lines;
482
483  my %cfg_label = %{ $self->config->setting ('CFG_LABEL') };
484
485  LINE: for my $line (@lines) {
486    my $label = $line->{LABEL};
487    my $value = $line->{VALUE};
488
489    next unless $label;
490    next if uc $label eq $cfg_label{CFGFILE}{TYPE};
491    next if uc $label eq $cfg_label{CFGFILE}{VERSION};
492
493    my ($prefix, $name) = split /::/, $label;
494
495    # Get name of file from the package cfg
496    my $srcfile;
497    if ($name) {
498      ($srcfile) = grep {$_->base eq $name} @{ $self->{SRCFILE} };
499
500      # Create new instance of Fcm::SrcFile if not already in package
501      if (not $srcfile) {
502        my $src    = find_file_in_path ($name, $self->{SEARCHPATH});
503        my $target = $name unless $src;
504
505        $srcfile   = Fcm::SrcFile->new (
506          CONFIG     => $self->config,
507          SRCPACKAGE => $self,
508          SRC        => $src ? $src : $name,
509          TARGET     => $target,
510          PCKCFG     => 1,
511        );
512        push @{ $self->{SRCFILE} }, $srcfile;
513
514      } else {
515        $srcfile->pckcfg (1);
516      }
517
518    } else {
519      w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
520               ': label "', $label, '" not recognised.';
521      next LINE;
522    }
523
524    $prefix = uc $prefix;
525    if ($prefix eq $cfg_label{TYPE}) {
526      # Type label of source file
527      $srcfile->type (uc $value);
528      $srcfile->scan (0) if $srcfile->is_type (qw/BINARY LIB/);
529      next LINE;
530
531    } elsif ($prefix eq $cfg_label{SCAN}) {
532      # Scan original file for dependency?
533      $srcfile->scan ($value);
534      next LINE;
535
536    } elsif ($prefix eq $cfg_label{TARGET}) {
537      # Name of build target for this source file
538      $srcfile->exebase ($value);
539      next LINE;
540
541    } elsif ($prefix eq $cfg_label{INTNAME}) {
542      # Program unit name of this source file
543      $srcfile->progname ($value);
544      next LINE;
545
546    } elsif ($prefix eq $cfg_label{DEP}) {
547      # Dependency of this source file
548      my ($type, $target) = split /::/, $value;
549      $srcfile->add_dep ($target, uc $type);
550      next LINE;
551
552    } else {
553      w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
554               ': label "', $label, '" not recognised.';
555      next LINE;
556    }
557  }
558
559  return 1;
560}
561
562# ------------------------------------------------------------------------------
563# SYNOPSIS
564#   $package->scan_dependency ();
565#   $package->scan_dependency (HEADER_ONLY => 1);
566#
567# DESCRIPTION
568#   This method scans the dependency in each source file in this source
569#   package and updates the package dependency cache. If HEADER_ONLY is
570#   specified, it performs dependency scan for pre-processor headers only if
571#   this source package requires pre-processing.
572# ------------------------------------------------------------------------------
573
574sub scan_dependency {
575  my $self = shift;
576  my %args = @_;
577
578  # Search for include header dependencies only
579  my $header_only = exists $args{HEADER_ONLY} ? $args{HEADER_ONLY} : 0;
580
581  # Get list of source files
582  # If header dependencies only, only consider FPP, C and CPP files
583  my @srcfiles = $header_only
584                 ? grep {$_->is_type_or (qw/FPP C CPP/)} $self->srcfile
585                 : grep {$_->type} $self->srcfile;
586  return unless @srcfiles;
587
588  # Location of the cache
589  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
590  my $cachebase = $header_only
591                  ? $self->_cache_basename ('PCKPPDEPEND')
592                  : $self->_cache_basename ('PCKDEPEND');
593  my $cachefile = find_file_in_path ($cachebase, \@cachepath);
594
595  # Obtain old dependency information from cache file if it exists
596  my %dep     = ();
597  my %intname = ();
598
599  if ($cachefile) {
600    # Read the cache
601    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $cachefile);
602    $cfg->read_cfg;
603    my @lines = $cfg->lines;
604
605    # Get list of source file base names
606    my %srcfilebase;
607    for (@srcfiles) {
608      my $base = $_->ppsrc ? $_->ppbase : $_->base;
609      $srcfilebase{$base} = 1;
610    }
611
612    for my $line (@lines) {
613      next unless $line->{LABEL};
614
615      # Label is either INTNAME or a dependency type name
616      # For INTNAME, value is the program unit name
617      # Otherwise, value is file::dependency
618      my $type = $line->{LABEL};
619      (my $file, my $depend) = split /::/, $line->{VALUE};
620
621      # Make sure $file exists in the list of source file base names
622      next unless exists $srcfilebase{$file};
623
624      if ($type eq 'INTNAME') {
625        $intname{$file} = $depend;
626
627      } else {
628        $dep{$file}{$depend} = $type;
629      }
630    }
631  }
632
633  # If a source file is newer than the cache file, re-scan dependency for that
634  # source file.
635  my $uptodate        = $cachefile ? 1 : 0;
636  my $cachefile_mtime = $cachefile ? (stat $cachefile) [9] : undef;
637  my $count           = 0;
638
639  for my $srcfile (@srcfiles) {
640    # Check modified time of source file
641    my $srcfile_mtime = $srcfile->mtime;
642
643    # If a package config file exists and it affects the source file,
644    # compare its timestamp with that of the source file
645    if ($srcfile->pckcfg) {
646      $srcfile_mtime = $self->cfg->mtime if not defined $srcfile_mtime;
647      $srcfile_mtime = ($self->cfg->mtime > $srcfile_mtime) ? $self->cfg->mtime
648                                                            : $srcfile_mtime;
649    }
650
651    # For files requiring PP, must re-scan if PP option has changed
652    my $rescan = ($self->newpp and $srcfile->is_type_or (qw/FPP C/)) ? 1 : 0;
653
654    if ($cachefile_mtime and $cachefile_mtime > $srcfile_mtime and ! $rescan) {
655      # No need to re-scan dependency, read dependency from cache
656      my $base = ($srcfile->ppsrc ? $srcfile->ppbase : $srcfile->base);
657
658      $srcfile->progname ($intname{$base}) if $intname{$base};
659      $srcfile->dep ($dep{$base})          if $dep{$base};
660
661    } else {
662      # Rescan dependency
663      $srcfile->progname (undef);
664      my $rc = $srcfile->scan_dependency (HEADER_ONLY => $header_only);
665      my %dp = $srcfile->dep;
666
667      # Get list of dependencies for updating the cache
668      my $base = ($srcfile->ppsrc ? $srcfile->ppbase : $srcfile->base);
669
670      $intname{$base} = $srcfile->progname;
671      $dep    {$base} = \%dp;
672
673      $uptodate = 0;
674      $count++ if $rc;
675    }
676  }
677
678  # Output diagnostic, if necessary
679  if ($self->config->verbose > 1 and $count) {
680    my $out =  $self->name . ': scanned ' . $count . ' file(s) for';
681    $out   .= ' header' if $header_only;
682    $out   .= ' dependency' . "\n";
683    print $out;
684  }
685
686  # Check whether package config file is newer than the dependency cache
687  if ($uptodate and $self->cfg) {
688    $uptodate = $cachefile_mtime > $self->cfg->mtime ? 1 : 0;
689  }
690
691  if (not $uptodate) {
692    # Update dependency cache file
693    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
694
695    # Program unit name of source files
696    for my $file (keys %intname) {
697      next unless $intname{$file};
698
699      $cfg->add_line (
700        LABEL => 'INTNAME',
701        VALUE => $file . '::' . $intname{$file},
702      );
703    }
704
705    # Dependencies of source files
706    for my $file (keys %dep) {
707      for my $depend (keys %{ $dep{$file} }) {
708        $cfg->add_line (
709          LABEL => $dep{$file}{$depend},
710          VALUE => $file . '::' . $depend,
711        );
712      }
713    }
714
715    # Create an empty config file if no dependency in this source package
716    $cfg->add_line unless $cfg->lines;
717
718    # Write to config file
719    my $outfile = catfile $cachepath[0], $cachebase;
720    $cfg->print_cfg ($outfile);
721  }
722
723  return not $uptodate;
724}
725
726# ------------------------------------------------------------------------------
727# SYNOPSIS
728#   $rc = $package->makerule_uptodate ();
729#
730# DESCRIPTION
731#   This method returns true if the make rule file for this source package
732#   is up to date.
733# ------------------------------------------------------------------------------
734
735sub makerule_uptodate {
736  my $self = shift;
737
738  my $return = 0;
739
740  if (not $self->newpp) {
741    # Check whether a Make rule file already exists
742    my $mkbase = $self->name . $self->config->setting (qw/OUTFILE_EXT MK/);
743    my $mkfile = find_file_in_path (
744      $mkbase,
745      $self->config->setting (qw/PATH BLD/),
746    );
747
748    # Check location of source package file type cache
749    my $pckfile = find_file_in_path (
750      $self->_cache_basename ('PCKFILE'),
751      $self->config->setting (qw/PATH CACHE/),
752    );
753
754    # Check location of source package dependency cache
755    my $pckdepend = find_file_in_path (
756      $self->_cache_basename ('PCKDEPEND'),
757      $self->config->setting (qw/PATH CACHE/),
758    );
759
760    # If make rule file exists, determine whether it is out of date
761    if ($pckdepend) {
762      if ($mkfile) {
763        my $pckfile_mt   = (stat $pckfile)  [9];
764        my $pckdepend_mt = (stat $pckdepend)[9];
765        my $mkfile_mt    = (stat $mkfile)   [9];
766
767        $return = 1 if $mkfile_mt >= $pckdepend_mt and $mkfile_mt >= $pckfile_mt;
768      }
769
770    } else {
771      $return = 1; # No cache file, no need to have a make rule
772    }
773  }
774
775  return $return;
776}
777
778# ------------------------------------------------------------------------------
779# SYNOPSIS
780#   $package->write_makerule ();
781#
782# DESCRIPTION
783#   This method writes to the I<Make> rule file of the current source package.
784# ------------------------------------------------------------------------------
785
786sub write_makerule {
787  my $self = shift;
788
789  # Package Make rule header
790  my $mk = '# Automatic Make rule for ' . $self->name . "\n\n";
791
792  # Set up variable for directory name
793  # if package name contains only word characters
794  my @searchpath   = $self->searchpath;
795  my @ppsearchpath = $self->ppsearchpath;
796
797  if ($self->name =~ /^\w+$/) {
798    # Package search path
799    my %path = (SRCDIR => \@searchpath, PPSRCDIR => \@ppsearchpath);
800
801    for my $key (keys %path) {
802      my $count = 0;
803      my @dirs  = @{ $path{$key} };
804
805      for my $i (0 .. $#dirs) {
806        next unless -d $dirs[$i];
807        $mk .= $key . $i . '__' . $self->name . ' = ' . $dirs[$i] . "\n";
808        $count++;
809      }
810
811      $mk .= "\n" if $count;
812    }
813  }
814
815  my $mk_out;
816
817  # Make rules for copying data files, if necessary
818  {
819    # Get a list of files with no associated type
820    my @files = grep {not $_->type} @{ $self->{SRCFILE} };
821
822    if (@files) {
823      my $target = $self->name . $self->config->setting (qw/OUTFILE_EXT ETC/);
824      $mk_out .= $target . ' :';
825
826      # Depends on all un-typed source files
827      my $nl = " \\\n" . ' ' x 10;
828      for my $file (@files) {
829        my $dir = $file->dir;
830
831        # Use variable for directory name
832        # if package name contains only word characters
833        if ($self->name =~ /^\w+$/) {
834          for my $i (0 .. $#searchpath) {
835            if ($dir eq $searchpath[$i]) {
836              $dir = '$(SRCDIR' . $i . '__' . $self->name . ')';
837              last;
838            }
839          }
840        }
841
842        $mk_out .= $nl . catfile ($dir, $file->base);
843      }
844
845      # Depends on dummy copy file, so there will be no dependency inheritance
846      $mk_out .= $nl . $self->config->setting (qw/MISC CPDUMMY/);
847
848      # Actions for target
849      $mk_out .= "\n";
850      $mk_out .= "\t" . 'cp $^ $(FCM_ETCDIR)' . "\n";
851      $mk_out .= "\t" . 'touch ' . catfile ('$(FCM_DONEDIR)', '$@') . "\n";
852
853      $mk_out .= "\n";
854    }
855  }
856
857  # Make rules for source files
858  my @srcfiles = grep {$_->type} @{ $self->{SRCFILE} };
859  for my $srcfile (@srcfiles) {
860    $mk_out .= $srcfile->write_makerules;
861  }
862
863  # Write make rule file only if necessary
864  if ($mk_out) {
865    $mk .= $mk_out;
866
867    # Write to output file
868    my $mkbase = $self->name . $self->config->setting (qw/OUTFILE_EXT MK/);
869    my $blddir = ${ $self->config->setting (qw/PATH BLD/) }[0];
870    my $mkfile = catfile $blddir, $mkbase;
871
872    if (not -d $blddir) {
873      print 'Make directory: ', $blddir, "\n" if $self->config->verbose > 1;
874      mkpath $blddir or croak $blddir, ': cannot create directory, abort';
875    }
876
877    open OUT, '>', $mkfile
878      or croak 'Cannot open "', $mkfile, '" (', $!, '), abort';
879    print OUT $mk;
880    close OUT or croak 'Cannot close "', $mkfile, '" (', $!, '), abort';
881
882    print 'Generated: ', $mkfile, "\n" if $self->config->verbose > 1;
883
884    return 1;
885
886  } else {
887    return 0;
888  }
889}
890
891# ------------------------------------------------------------------------------
892
8931;
894
895__END__
Note: See TracBrowser for help on using the repository browser.