source: codes/icosagcm/trunk/tools/FCM/lib/Fcm/SrcPackage.pm @ 10

Last change on this file since 10 was 10, checked in by ymipsl, 12 years ago

dynamico tree creation

YM
File size: 25.0 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#   @srcfile = $package->srcfile;
240#
241# DESCRIPTION
242#   This method returns a list of references to Fcm::SrcFile instances
243#   associated with this package.
244# ------------------------------------------------------------------------------
245
246sub srcfile {
247  my $self = shift;
248
249  return @{ $self->{SRCFILE} };
250}
251
252# ------------------------------------------------------------------------------
253# SYNOPSIS
254#   $package->update_file_info ();
255#
256# DESCRIPTION
257#   This method updates the source file information of this package. Please
258#   note that information is only updated if the cache file for this package
259#   does not exist. For a package declared in the current build, the
260#   information is also updated if the cache file is out of date.
261# ------------------------------------------------------------------------------
262
263sub update_file_info {
264  my $self      = shift;
265
266  # Check if the cache file exists and up to date
267  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
268  my $cachefile = find_file_in_path ($self->_cache_basename, \@cachepath);
269
270  my $uptodate  = $cachefile ? 1 : 0;
271  if ($uptodate and $self->{CURRENT}) {
272    # Is cache file up to date compared with directory?
273    $uptodate = (stat $cachefile) [9] > (stat $self->{SEARCHPATH}[0]) [9];
274
275    # Is cache file up to date compared with each file?
276    if ($uptodate) {
277      my $dir = $self->{SEARCHPATH}[0];
278
279      if (opendir DIR, $dir) {
280        my @files = map {catfile $dir, $_} grep {!/^\.\.?/} readdir 'DIR';
281        closedir DIR;
282        $uptodate = (grep {(stat $cachefile) [9] > (stat) [9]} @files) ? 1 : 0;
283      }
284    }
285  }
286
287  # Read package source file information if it appears to be up to date
288  $uptodate = $self->_read_file_list_cache ($cachefile) if ($uptodate);
289
290  # Update package source file information if necessary
291  if (not $uptodate) {
292    # Get list of files by searching through the search path
293    my @files = ();
294    for my $dir (@{ $self->{SEARCHPATH} }) {
295      opendir DIR, $dir;
296      while (my $base = readdir 'DIR') {
297        next if $base =~ /^\./;
298
299        my $file = catfile $dir, $base;
300        next if -d $file;
301
302        push @files, $file unless grep {basename ($_) eq $base} @files;
303      }
304      closedir DIR;
305    }
306
307    # Declare new instances of source file objects
308    my @srcfile = ();
309    for my $file (@files) {
310      if (basename ($file) eq $self->config->setting (qw/CFG_NAME SRCPACKAGE/)) {
311        $self->{CFG} = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
312
313      } else {
314        my $srcfile = Fcm::SrcFile->new (
315          CONFIG     => $self->config,
316          SRC        => $file,
317          SRCPACKAGE => $self,
318        );
319
320        # Determine source file types
321        $srcfile->determine_type;
322
323        # Record files of known types
324        push @srcfile, $srcfile;
325      }
326    }
327
328    # Set each SRCFILE to reference the source file instances
329    $self->{SRCFILE} = \@srcfile;
330
331    # Decipher configuration file if necessary
332    $self->_decipher_cfg if $self->cfg;
333
334    # Write to a new cache file
335    $self->_update_file_list_cache ();
336
337    # Source package info updated. Make sure the "current" flag is set to true
338    $self->current (1);
339  }
340
341  return;
342}
343
344# ------------------------------------------------------------------------------
345# SYNOPSIS
346#   $up_to_date = $self->_read_file_list_cache ($file);
347#
348# DESCRIPTION
349#   This internal method reads the cache $file of this package and assigns the
350#   information to the SRCFILE list. It returns true if the cache appears to
351#   be up to date.
352# ------------------------------------------------------------------------------
353
354sub _read_file_list_cache {
355  my $self = shift;
356  my $file = shift;
357
358  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
359
360  # Read from config file
361  $cfg->read_cfg;
362  my @lines = $cfg->lines;
363
364  my %filetype = ();
365  my $uptodate = 1;
366  for my $line (@lines) {
367    next unless $line->{LABEL};
368
369    # On package declared in the current build, check that file is not deleted
370    if (not -f $line->{LABEL}) {
371      $uptodate = 0;
372      last;
373    }
374
375    $filetype{$line->{LABEL}} = $line->{VALUE};
376  }
377
378  # Assign to SRCFILE list if cache file is up to date
379  if ($uptodate) {
380    my @srcfiles = ();
381
382    for my $file (sort keys %filetype) {
383      if ($filetype{$file} eq 'SRCPACKAGECFG') {
384        $self->{CFG} = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $file);
385
386      } else {
387        my $srcfile = Fcm::SrcFile->new (
388          CONFIG     => $self->config,
389          SRC        => $file,
390          TYPE       => $filetype{$file},
391          SRCPACKAGE => $self,
392        );
393
394        push @srcfiles, $srcfile;
395      }
396    }
397
398    $self->{SRCFILE} = [@srcfiles];
399
400    $self->_decipher_cfg if $self->cfg;
401  }
402
403  return $uptodate;
404}
405
406# ------------------------------------------------------------------------------
407# SYNOPSIS
408#   $self->_update_file_list_cache (\@cachepath);
409#
410# DESCRIPTION
411#   This internal method updates the cache file of this package by writing
412#   current SRCFILE information to it. The argument @cachepath must be the
413#   search path of the build cache directory.
414# ------------------------------------------------------------------------------
415
416sub _update_file_list_cache {
417  my $self      = shift;
418  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
419
420  my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
421
422  if ($self->{CFG}) {
423    $cfg->add_line (LABEL => $self->cfg->src, VALUE => 'SRCPACKAGECFG')
424  }
425
426  for my $file (@{ $self->{SRCFILE} }) {
427    $cfg->add_line (LABEL => $file->src, VALUE => $file->type);
428  }
429
430  my $cachefile = catfile $cachepath[0], $self->_cache_basename;
431  $cfg->print_cfg ($cachefile);
432
433  return;
434}
435
436# ------------------------------------------------------------------------------
437# SYNOPSIS
438#   $basename = $self->_cache_basename ($type);
439#
440# DESCRIPTION
441#   This internal method returns the basename of a cache file for this
442#   package. If no argument is specified, it returns the package file list
443#   cache name. Otherwise, it returns the package file dependency cache name.
444# ------------------------------------------------------------------------------
445
446sub _cache_basename {
447  my $self = shift;
448  my $type = $_[0] ? $_[0] : 'PCKFILE';
449
450  return $self->{NAME} . $self->config->setting ('CACHE', $type);
451}
452
453# ------------------------------------------------------------------------------
454# SYNOPSIS
455#   $self->_decipher_cfg ();
456#
457# DESCRIPTION
458#   This internal method deciphers the CFG file associated with this source
459#   package.
460# ------------------------------------------------------------------------------
461
462sub _decipher_cfg {
463  my $self = shift;
464
465  $self->cfg->read_cfg;
466  my @lines = $self->cfg->lines;
467
468  my %cfg_label = %{ $self->config->setting ('CFG_LABEL') };
469
470  LINE: for my $line (@lines) {
471    my $label = $line->{LABEL};
472    my $value = $line->{VALUE};
473
474    next unless $label;
475    next if uc $label eq $cfg_label{CFGFILE}{TYPE};
476    next if uc $label eq $cfg_label{CFGFILE}{VERSION};
477
478    my ($prefix, $name) = split /::/, $label;
479
480    # Get name of file from the package cfg
481    my $srcfile;
482    if ($name) {
483      ($srcfile) = grep {$_->base eq $name} @{ $self->{SRCFILE} };
484
485      # Create new instance of Fcm::SrcFile if not already in package
486      if (not $srcfile) {
487        my $src    = find_file_in_path ($name, $self->{SEARCHPATH});
488        my $target = $name unless $src;
489
490        $srcfile   = Fcm::SrcFile->new (
491          CONFIG     => $self->config,
492          SRCPACKAGE => $self,
493          SRC        => $src ? $src : $name,
494          TARGET     => $target,
495          PCKCFG     => 1,
496        );
497        push @{ $self->{SRCFILE} }, $srcfile;
498
499      } else {
500        $srcfile->pckcfg (1);
501      }
502
503    } else {
504      w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
505               ': label "', $label, '" not recognised.';
506      next LINE;
507    }
508
509    $prefix = uc $prefix;
510    if ($prefix eq $cfg_label{TYPE}) {
511      # Type label of source file
512      $srcfile->type (uc $value);
513      $srcfile->scan (0) if $srcfile->is_type (qw/BINARY LIB/);
514      next LINE;
515
516    } elsif ($prefix eq $cfg_label{SCAN}) {
517      # Scan original file for dependency?
518      $srcfile->scan ($value);
519      next LINE;
520
521    } elsif ($prefix eq $cfg_label{TARGET}) {
522      # Name of build target for this source file
523      $srcfile->target ($value);
524      next LINE;
525
526    } elsif ($prefix eq $cfg_label{INTNAME}) {
527      # Program unit name of this source file
528      $srcfile->progname ($value);
529      next LINE;
530
531    } elsif ($prefix eq $cfg_label{DEP}) {
532      # Dependency of this source file
533      my ($type, $target) = split /::/, $value;
534      $srcfile->add_dep ($target, uc $type);
535      next LINE;
536
537    } else {
538      w_report 'Warning: ', $line->{SRC}, ': LINE ', $line->{NUMBER},
539               ': label "', $label, '" not recognised.';
540      next LINE;
541    }
542  }
543
544  return 1;
545}
546
547# ------------------------------------------------------------------------------
548# SYNOPSIS
549#   $package->scan_dependency ();
550#   $package->scan_dependency (HEADER_ONLY => 1);
551#
552# DESCRIPTION
553#   This method scans the dependency in each source file in this source
554#   package and updates the package dependency cache. If HEADER_ONLY is
555#   specified, it performs dependency scan for pre-processor headers only if
556#   this source package requires pre-processing.
557# ------------------------------------------------------------------------------
558
559sub scan_dependency {
560  my $self = shift;
561  my %args = @_;
562
563  # Search for include header dependencies only
564  my $header_only = exists $args{HEADER_ONLY} ? $args{HEADER_ONLY} : 0;
565
566  # Get list of source files
567  # If header dependencies only, only consider FPP, C and CPP files
568  my @srcfiles = $header_only
569                 ? grep {$_->is_type_or (qw/FPP C CPP/)} $self->srcfile
570                 : grep {$_->type} $self->srcfile;
571  return unless @srcfiles;
572
573  # Location of the cache
574  my @cachepath = @{ $self->config->setting (qw/PATH CACHE/) };
575  my $cachebase = $header_only
576                  ? $self->_cache_basename ('PCKPPDEPEND')
577                  : $self->_cache_basename ('PCKDEPEND');
578  my $cachefile = find_file_in_path ($cachebase, \@cachepath);
579
580  # Obtain old dependency information from cache file if it exists
581  my %dep     = ();
582  my %intname = ();
583
584  if ($cachefile) {
585    # Read the cache
586    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config, SRC => $cachefile);
587    $cfg->read_cfg;
588    my @lines = $cfg->lines;
589
590    # Get list of source file base names
591    my %srcfilebase;
592    for (@srcfiles) {
593      my $base = $_->ppsrc ? $_->ppbase : $_->base;
594      $srcfilebase{$base} = 1;
595    }
596
597    for my $line (@lines) {
598      next unless $line->{LABEL};
599
600      # Label is either INTNAME or a dependency type name
601      # For INTNAME, value is the program unit name
602      # Otherwise, value is file::dependency
603      my $type = $line->{LABEL};
604      (my $file, my $depend) = split /::/, $line->{VALUE};
605
606      # Make sure $file exists in the list of source file base names
607      next unless exists $srcfilebase{$file};
608
609      if ($type eq 'INTNAME') {
610        $intname{$file} = $depend;
611
612      } else {
613        $dep{$file}{$depend} = $type;
614      }
615    }
616  }
617
618  # If a source file is newer than the cache file, re-scan dependency for that
619  # source file.
620  my $uptodate        = $cachefile ? 1 : 0;
621  my $cachefile_mtime = $cachefile ? (stat $cachefile) [9] : undef;
622  my $count           = 0;
623
624  for my $srcfile (@srcfiles) {
625    # Check modified time of source file
626    my $srcfile_mtime = $srcfile->mtime;
627
628    # If a package config file exists and it affects the source file,
629    # compare its timestamp with that of the source file
630    if ($srcfile->pckcfg) {
631      $srcfile_mtime = $self->cfg->mtime if not defined $srcfile_mtime;
632      $srcfile_mtime = ($self->cfg->mtime > $srcfile_mtime) ? $self->cfg->mtime
633                                                            : $srcfile_mtime;
634    }
635
636    # For files requiring PP, must re-scan if PP option has changed
637    my $rescan = ($self->newpp and $srcfile->is_type_or (qw/FPP C/)) ? 1 : 0;
638
639    if ($cachefile_mtime and $cachefile_mtime > $srcfile_mtime and ! $rescan) {
640      # No need to re-scan dependency, read dependency from cache
641      my $base = ($srcfile->ppsrc ? $srcfile->ppbase : $srcfile->base);
642
643      $srcfile->progname ($intname{$base}) if $intname{$base};
644      $srcfile->dep ($dep{$base})          if $dep{$base};
645
646    } else {
647      # Rescan dependency
648      $srcfile->progname (undef);
649      my $rc = $srcfile->scan_dependency (HEADER_ONLY => $header_only);
650      my %dp = $srcfile->dep;
651
652      # Get list of dependencies for updating the cache
653      my $base = ($srcfile->ppsrc ? $srcfile->ppbase : $srcfile->base);
654
655      $intname{$base} = $srcfile->progname;
656      $dep    {$base} = \%dp;
657
658      $uptodate = 0;
659      $count++ if $rc;
660    }
661  }
662
663  # Output diagnostic, if necessary
664  if ($self->config->verbose > 1 and $count) {
665    my $out =  $self->name . ': scanned ' . $count . ' file(s) for';
666    $out   .= ' header' if $header_only;
667    $out   .= ' dependency' . "\n";
668    print $out;
669  }
670
671  # Check whether package config file is newer than the dependency cache
672  if ($uptodate and $self->cfg) {
673    $uptodate = $cachefile_mtime > $self->cfg->mtime ? 1 : 0;
674  }
675
676  if (not $uptodate) {
677    # Update dependency cache file
678    my $cfg = Fcm::CfgFile->new (CONFIG => $self->config);
679
680    # Program unit name of source files
681    for my $file (keys %intname) {
682      next unless $intname{$file};
683
684      $cfg->add_line (
685        LABEL => 'INTNAME',
686        VALUE => $file . '::' . $intname{$file},
687      );
688    }
689
690    # Dependencies of source files
691    for my $file (keys %dep) {
692      for my $depend (keys %{ $dep{$file} }) {
693        $cfg->add_line (
694          LABEL => $dep{$file}{$depend},
695          VALUE => $file . '::' . $depend,
696        );
697      }
698    }
699
700    # Create an empty config file if no dependency in this source package
701    $cfg->add_line unless $cfg->lines;
702
703    # Write to config file
704    my $outfile = catfile $cachepath[0], $cachebase;
705    $cfg->print_cfg ($outfile);
706  }
707
708  return not $uptodate;
709}
710
711# ------------------------------------------------------------------------------
712# SYNOPSIS
713#   $rc = $package->makerule_uptodate ();
714#
715# DESCRIPTION
716#   This method returns true if the make rule file for this source package
717#   is up to date.
718# ------------------------------------------------------------------------------
719
720sub makerule_uptodate {
721  my $self = shift;
722
723  my $return = 0;
724
725  if (not $self->newpp) {
726    # Check whether a Make rule file already exists
727    my $mkbase = $self->name . $self->config->setting (qw/OUTFILE_EXT MK/);
728    my $mkfile = find_file_in_path (
729      $mkbase,
730      $self->config->setting (qw/PATH BLD/),
731    );
732
733    # Check location of source package file type cache
734    my $pckfile = find_file_in_path (
735      $self->_cache_basename ('PCKFILE'),
736      $self->config->setting (qw/PATH CACHE/),
737    );
738
739    # Check location of source package dependency cache
740    my $pckdepend = find_file_in_path (
741      $self->_cache_basename ('PCKDEPEND'),
742      $self->config->setting (qw/PATH CACHE/),
743    );
744
745    # If make rule file exists, determine whether it is out of date
746    if ($pckdepend) {
747      if ($mkfile) {
748        my $pckfile_mt   = (stat $pckfile)  [9];
749        my $pckdepend_mt = (stat $pckdepend)[9];
750        my $mkfile_mt    = (stat $mkfile)   [9];
751
752        $return = 1 if $mkfile_mt >= $pckdepend_mt and $mkfile_mt >= $pckfile_mt;
753      }
754
755    } else {
756      $return = 1; # No cache file, no need to have a make rule
757    }
758  }
759
760  return $return;
761}
762
763# ------------------------------------------------------------------------------
764# SYNOPSIS
765#   $package->write_makerule ();
766#
767# DESCRIPTION
768#   This method writes to the I<Make> rule file of the current source package.
769# ------------------------------------------------------------------------------
770
771sub write_makerule {
772  my $self = shift;
773
774  # Package Make rule header
775  my $mk = '# Automatic Make rule for ' . $self->name . "\n\n";
776
777  # Set up variable for directory name
778  # if package name contains only word characters
779  my @searchpath   = ();
780  my @ppsearchpath = ();
781  if ($self->name =~ /^\w+$/) {
782    # Package search path
783    @searchpath = $self->searchpath;
784    for my $i (0 .. $#searchpath) {
785      $mk .= 'SRCDIR' . $i . '__' . $self->name . ' = ' . $searchpath[$i];
786      $mk .= "\n";
787    }
788    $mk .= "\n" if @searchpath;
789
790    # Package PP search path
791    @ppsearchpath = $self->ppsearchpath;
792    for my $i (0 .. $#ppsearchpath) {
793      next unless -d $ppsearchpath[$i];
794      $mk .= 'PPSRCDIR' . $i . '__' . $self->name . ' = ' . $ppsearchpath[$i];
795      $mk .= "\n";
796    }
797    $mk .= "\n" if @ppsearchpath;
798  }
799
800  my $mk_out;
801
802  # Make rules for copying data files, if necessary
803  {
804    # Get a list of files with no associated type
805    my @files = grep {not $_->type} @{ $self->{SRCFILE} };
806
807    if (@files) {
808      my $target = $self->name . $self->config->setting (qw/OUTFILE_EXT ETC/);
809      $mk_out .= $target . ' :';
810
811      # Depends on all un-typed source files
812      my $nl = " \\\n" . ' ' x 10;
813      for my $file (@files) {
814        my $dir = $file->dir;
815
816        # Use variable for directory name
817        # if package name contains only word characters
818        if ($self->name =~ /^\w+$/) {
819          for my $i (0 .. $#searchpath) {
820            if ($dir eq $searchpath[$i]) {
821              $dir = '$(SRCDIR' . $i . '__' . $self->name . ')';
822              last;
823            }
824          }
825        }
826
827        $mk_out .= $nl . catfile ($dir, $file->base);
828      }
829
830      # Depends on dummy copy file, so there will be no dependency inheritance
831      $mk_out .= $nl . $self->config->setting (qw/MISC CPDUMMY/);
832
833      # Actions for target
834      $mk_out .= "\n";
835      $mk_out .= "\t" . 'cp $^ $(FCM_ETCDIR)' . "\n";
836      $mk_out .= "\t" . 'touch ' . catfile ('$(FCM_DONEDIR)', '$@') . "\n";
837
838      $mk_out .= "\n";
839    }
840  }
841
842  # Make rules for source files
843  my @srcfiles = grep {$_->type} @{ $self->{SRCFILE} };
844  for my $srcfile (@srcfiles) {
845    $mk_out .= $srcfile->write_makerule;
846  }
847
848  # Write make rule file only if necessary
849  if ($mk_out) {
850    $mk .= $mk_out;
851
852    # Write to output file
853    my $mkbase = $self->name . $self->config->setting (qw/OUTFILE_EXT MK/);
854    my $blddir = ${ $self->config->setting (qw/PATH BLD/) }[0];
855    my $mkfile = catfile $blddir, $mkbase;
856
857    if (not -d $blddir) {
858      print 'Make directory: ', $blddir, "\n" if $self->config->verbose > 1;
859      mkpath $blddir or croak $blddir, ': cannot create directory, abort';
860    }
861
862    open OUT, '>', $mkfile
863      or croak 'Cannot open "', $mkfile, '" (', $!, '), abort';
864    print OUT $mk;
865    close OUT or croak 'Cannot close "', $mkfile, '" (', $!, '), abort';
866
867    print 'Generated: ', $mkfile, "\n" if $self->config->verbose > 1;
868  }
869
870  return 1;
871}
872
873# ------------------------------------------------------------------------------
874
8751;
876
877__END__
Note: See TracBrowser for help on using the repository browser.