ExtractSrc.pm 2.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687
  1. # ------------------------------------------------------------------------------
  2. # NAME
  3. # Fcm::ExtractSrc
  4. #
  5. # DESCRIPTION
  6. # This class is used by the extract system to define the functionalities of a
  7. # source file (or directory) in a branch.
  8. #
  9. # COPYRIGHT
  10. # (C) Crown copyright Met Office. All rights reserved.
  11. # For further details please refer to the file COPYRIGHT.txt
  12. # which you should have received as part of this distribution.
  13. # ------------------------------------------------------------------------------
  14. package Fcm::ExtractSrc;
  15. @ISA = qw(Fcm::Base);
  16. # Standard pragma
  17. use warnings;
  18. use strict;
  19. # FCM component modules
  20. use Fcm::Base;
  21. # List of scalar property methods for this class
  22. my @scalar_properties = (
  23. 'cache', # location of the cache of this file in the current extract
  24. 'id', # short ID of the branch where this file is from
  25. 'ignore', # if set to true, ignore this file from this source
  26. 'pkgname', # package name of this file
  27. 'rev', # last changed revision/timestamp of this file
  28. 'uri', # URL/source path of this file
  29. );
  30. # ------------------------------------------------------------------------------
  31. # SYNOPSIS
  32. # $obj = Fcm::ExtractSrc->new (%args);
  33. #
  34. # DESCRIPTION
  35. # This method constructs a new instance of the Fcm::ExtractSrc class. See
  36. # @scalar_properties above for allowed list of properties in the constructor.
  37. # ------------------------------------------------------------------------------
  38. sub new {
  39. my $this = shift;
  40. my %args = @_;
  41. my $class = ref $this || $this;
  42. my $self = Fcm::Base->new (%args);
  43. for (@scalar_properties) {
  44. $self->{$_} = exists $args{$_} ? $args{$_} : undef;
  45. }
  46. bless $self, $class;
  47. return $self;
  48. }
  49. # ------------------------------------------------------------------------------
  50. # SYNOPSIS
  51. # $value = $obj->X;
  52. # $obj->X ($value);
  53. #
  54. # DESCRIPTION
  55. # Details of these properties are explained in @scalar_properties.
  56. # ------------------------------------------------------------------------------
  57. for my $name (@scalar_properties) {
  58. no strict 'refs';
  59. *$name = sub {
  60. my $self = shift;
  61. # Argument specified, set property to specified argument
  62. if (@_) {
  63. $self->{$name} = $_[0];
  64. }
  65. return $self->{$name};
  66. }
  67. }
  68. # ------------------------------------------------------------------------------
  69. 1;
  70. __END__