perl/Git/Tag.pm

   1 =head1 NAME
   2
   3 Git::Tag - Object-oriented interface to Git tag objects.
   4
   5 =head1 DESCRIPTION
   6
   7 Git::Tag is a class representing a tag object in a Git repository.  It
   8 stringifies to the tag object's SHA1.
   9
  10 =cut
  11
  12 use strict;
  13 use warnings;
  14
  15
  16 package Git::Tag;
  17
  18 use base qw(Git::Object);
  19
  20
  21 # Keep documentation in one place to save space.
  22
  23 =head1 METHODS
  24
  25 =head2 General Methods
  26
  27 =over
  28
  29 =item $tag = Git::Tag->new($repo, $sha1)
  30
  31 Return a new Git::Tag instance for a tag object with $sha1 in
  32 repository $repo.
  33
  34 The tag object is loaded lazily.  Hence, calls to this method are
  35 free, and it does not check whether $sha1 exists and has the right
  36 type.  However, accessing any of the tag object's properties will fail
  37 if $sha1 is not a valid tag object.
  38
  39 The tagger and message methods return Unicode strings, decoded
  40 according to the "encoding" header, with UTF-8 and then Latin-1 as
  41 fallbacks.  (These Unicode strings can contain code points greater
  42 than 256 and are *not* UTF-8 strings; see man perlunitut on how Perl
  43 handles Unicode.)
  44
  45 You will usually want to call $repo->get_tag($sha1) instead of
  46 instantiating this class directly; see L<Git::Repo>.
  47
  48 =item $obj->repo
  49
  50 Return the Git::Repo instance this object was instantiated with.
  51
  52 =item $obj->sha1
  53
  54 Return the SHA1 of this tag object, as provided at instantiation time.
  55
  56 =back
  57
  58 =head2 Property Methods
  59
  60 Calling any of these methods will cause the commit object to be loaded
  61 from the repository, if it hasn't been loaded already.
  62
  63 =over
  64
  65 =item $tag->object
  66
  67 Return the SHA1 string of the object referenced by this tag.
  68
  69 =item $tag->type
  70
  71 Return the type of the referenced object, as claimed by the tag
  72 object.  This is usually 'commit', but can be any of 'tag', 'commit',
  73 'tree', or 'blob'.
  74
  75 =item $tag->tagger
  76
  77 Return the tagger string of this tag object.
  78
  79 =item $tag->message
  80
  81 Return the undecoded tag message of this tag object.
  82
  83 =item $tag->encoding
  84
  85 Return the encoding header of the tag object, or undef if no encoding
  86 header is present; note that Git::Tag does the necessary decoding for
  87 you, so you should not normally need this method.
  88
  89 =back
  90
  91 =cut
  92
  93
  94 sub object {
  95         my $self = shift;
  96         $self->_load;
  97         return $self->{object};
  98 }
  99
 100 sub type {
 101         my $self = shift;
 102         $self->_load;
 103         return $self->{type};
 104 }
 105
 106 sub tag {
 107         my $self = shift;
 108         $self->_load;
 109         return $self->_decode($self->{tag});
 110 }
 111
 112 sub tagger {
 113         my $self = shift;
 114         $self->_load;
 115         return $self->_decode($self->{tagger});
 116 }
 117
 118 sub message {
 119         my $self = shift;
 120         $self->_load;
 121         return $self->_decode($self->{message});
 122 }
 123
 124 sub encoding {
 125         my $self = shift;
 126         $self->_load;
 127         return $self->{encoding};
 128 }
 129
 130 # Auxiliary method to load (and parse) the tag object from the
 131 # repository if it hasn't already been loaded.  Optional parameter:
 132 # The raw contents of the tag object; the tag object will be retrieved
 133 # from the repository if that parameter is not given.
 134 sub _load {
 135         my ($self, $raw_text) = shift;
 136         return if exists $self->{message};  # already loaded
 137
 138         my $sha1 = $self->sha1;
 139         if (!defined $raw_text) {
 140                 (my $type, $raw_text) = $self->repo->get_object($sha1);
 141                 die "$sha1 is a $type object (expected a tag object)"
 142                     unless $type eq 'tag';
 143         }
 144
 145         (my $header, $self->{message}) = split "\n\n", $raw_text, 2;
 146         # Parse header.
 147         for my $line (split "\n", $header) {
 148                 local $/ = "\n"; # for chomp
 149                 chomp($line);
 150                 my ($key, $value) = split ' ', $line, 2;
 151                 if ($key eq 'object') {
 152                         $self->{object} = $value;
 153                 } elsif ($key eq 'type') {
 154                         $self->{type} = $value;
 155                 } elsif ($key eq 'tag') {
 156                         $self->{tag} = $value;
 157                 } elsif ($key eq 'tagger') {
 158                         $self->{tagger} = $value;
 159                 } elsif ($key eq 'encoding') {
 160                         $self->{encoding} = $value;
 161                 } else {
 162                         # Ignore unrecognized header lines.
 163                 }
 164         }
 165         undef;
 166 }
 167
 168
 169 1;