Info.pm 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201
  1. # Copyright © 2007-2010 Raphaël Hertzog <hertzog@debian.org>
  2. #
  3. # This program is free software; you can redistribute it and/or modify
  4. # it under the terms of the GNU General Public License as published by
  5. # the Free Software Foundation; either version 2 of the License, or
  6. # (at your option) any later version.
  7. #
  8. # This program is distributed in the hope that it will be useful,
  9. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. # GNU General Public License for more details.
  12. #
  13. # You should have received a copy of the GNU General Public License
  14. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  15. package Dpkg::Control::Info;
  16. use strict;
  17. use warnings;
  18. our $VERSION = "1.00";
  19. use Dpkg::Control;
  20. use Dpkg::ErrorHandling;
  21. use Dpkg::Gettext;
  22. use base qw(Dpkg::Interface::Storable);
  23. use overload
  24. '@{}' => sub { return [ $_[0]->{source}, @{$_[0]->{packages}} ] };
  25. =head1 NAME
  26. Dpkg::Control::Info - parse files like debian/control
  27. =head1 DESCRIPTION
  28. It provides an object to access data of files that follow the same
  29. syntax than debian/control.
  30. =head1 FUNCTIONS
  31. =over 4
  32. =item $c = Dpkg::Control::Info->new($file)
  33. Create a new Dpkg::Control::Info object for $file. If $file is omitted, it
  34. loads debian/control. If file is "-", it parses the standard input.
  35. =cut
  36. sub new {
  37. my ($this, $arg) = @_;
  38. my $class = ref($this) || $this;
  39. my $self = {
  40. 'source' => undef,
  41. 'packages' => [],
  42. };
  43. bless $self, $class;
  44. if ($arg) {
  45. $self->load($arg);
  46. } else {
  47. $self->load("debian/control");
  48. }
  49. return $self;
  50. }
  51. =item $c->reset()
  52. Resets what got read.
  53. =cut
  54. sub reset {
  55. my $self = shift;
  56. $self->{source} = undef;
  57. $self->{packages} = [];
  58. }
  59. =item $c->load($file)
  60. Load the content of $file. Exits in case of errors. If file is "-", it
  61. loads from the standard input.
  62. =item $c->parse($fh, $description)
  63. Parse a control file from the given filehandle. Exits in case of errors.
  64. $description is used to describe the filehandle, ideally it's a filename
  65. or a description of where the data comes from. It's used in error
  66. messages.
  67. =cut
  68. sub parse {
  69. my ($self, $fh, $desc) = @_;
  70. $self->reset();
  71. my $cdata = Dpkg::Control->new(type => CTRL_INFO_SRC);
  72. return if not $cdata->parse($fh, $desc);
  73. $self->{source} = $cdata;
  74. unless (exists $cdata->{Source}) {
  75. syntaxerr($desc, _g("first block lacks a source field"));
  76. }
  77. while (1) {
  78. $cdata = Dpkg::Control->new(type => CTRL_INFO_PKG);
  79. last if not $cdata->parse($fh, $desc);
  80. push @{$self->{packages}}, $cdata;
  81. unless (exists $cdata->{Package}) {
  82. syntaxerr($desc, _g("block lacks a package field"));
  83. }
  84. }
  85. }
  86. =item $c->[0]
  87. =item $c->get_source()
  88. Returns a Dpkg::Control object containing the fields concerning the
  89. source package.
  90. =cut
  91. sub get_source {
  92. my $self = shift;
  93. return $self->{source};
  94. }
  95. =item $c->get_pkg_by_idx($idx)
  96. Returns a Dpkg::Control object containing the fields concerning the binary
  97. package numbered $idx (starting at 1).
  98. =cut
  99. sub get_pkg_by_idx {
  100. my ($self, $idx) = @_;
  101. return $self->{packages}[--$idx];
  102. }
  103. =item $c->get_pkg_by_name($name)
  104. Returns a Dpkg::Control object containing the fields concerning the binary
  105. package named $name.
  106. =cut
  107. sub get_pkg_by_name {
  108. my ($self, $name) = @_;
  109. foreach my $pkg (@{$self->{packages}}) {
  110. return $pkg if ($pkg->{Package} eq $name);
  111. }
  112. return undef;
  113. }
  114. =item $c->get_packages()
  115. Returns a list containing the Dpkg::Control objects for all binary packages.
  116. =cut
  117. sub get_packages {
  118. my $self = shift;
  119. return @{$self->{packages}};
  120. }
  121. =item $c->output($filehandle)
  122. Dump the content into a filehandle.
  123. =cut
  124. sub output {
  125. my ($self, $fh) = @_;
  126. my $str;
  127. $str .= $self->{source}->output($fh);
  128. foreach my $pkg (@{$self->{packages}}) {
  129. print $fh "\n";
  130. $str .= "\n" . $pkg->output($fh);
  131. }
  132. return $str;
  133. }
  134. =item "$c"
  135. Return a string representation of the content.
  136. =item @{$c}
  137. Return a list of Dpkg::Control objects, the first one is corresponding to
  138. source information and the following ones are the binary packages
  139. information.
  140. =back
  141. =head1 AUTHOR
  142. Raphael Hertzog <hertzog@debian.org>.
  143. =cut
  144. 1;