Info.pm 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199
  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. use Dpkg::Control;
  19. use Dpkg::ErrorHandling;
  20. use Dpkg::Gettext;
  21. use base qw(Dpkg::Interface::Storable);
  22. use overload
  23. '@{}' => sub { return [ $_[0]->{source}, @{$_[0]->{packages}} ] };
  24. =head1 NAME
  25. Dpkg::Control::Info - parse files like debian/control
  26. =head1 DESCRIPTION
  27. It provides an object to access data of files that follow the same
  28. syntax than debian/control.
  29. =head1 FUNCTIONS
  30. =over 4
  31. =item $c = Dpkg::Control::Info->new($file)
  32. Create a new Dpkg::Control::Info object for $file. If $file is omitted, it
  33. loads debian/control. If file is "-", it parses the standard input.
  34. =cut
  35. sub new {
  36. my ($this, $arg) = @_;
  37. my $class = ref($this) || $this;
  38. my $self = {
  39. 'source' => undef,
  40. 'packages' => [],
  41. };
  42. bless $self, $class;
  43. if ($arg) {
  44. $self->load($arg);
  45. } else {
  46. $self->load("debian/control");
  47. }
  48. return $self;
  49. }
  50. =item $c->reset()
  51. Resets what got read.
  52. =cut
  53. sub reset {
  54. my $self = shift;
  55. $self->{source} = undef;
  56. $self->{packages} = [];
  57. }
  58. =item $c->load($file)
  59. Load the content of $file. Exits in case of errors. If file is "-", it
  60. loads from the standard input.
  61. =item $c->parse($fh, $description)
  62. Parse a control file from the given filehandle. Exits in case of errors.
  63. $description is used to describe the filehandle, ideally it's a filename
  64. or a description of where the data comes from. It's used in error
  65. messages.
  66. =cut
  67. sub parse {
  68. my ($self, $fh, $desc) = @_;
  69. $self->reset();
  70. my $cdata = Dpkg::Control->new(type => CTRL_INFO_SRC);
  71. return if not $cdata->parse($fh, $desc);
  72. $self->{source} = $cdata;
  73. unless (exists $cdata->{Source}) {
  74. syntaxerr($desc, _g("first block lacks a source field"));
  75. }
  76. while (1) {
  77. $cdata = Dpkg::Control->new(type => CTRL_INFO_PKG);
  78. last if not $cdata->parse($fh, $desc);
  79. push @{$self->{packages}}, $cdata;
  80. unless (exists $cdata->{Package}) {
  81. syntaxerr($desc, _g("block lacks a package field"));
  82. }
  83. }
  84. }
  85. =item $c->[0]
  86. =item $c->get_source()
  87. Returns a Dpkg::Control object containing the fields concerning the
  88. source package.
  89. =cut
  90. sub get_source {
  91. my $self = shift;
  92. return $self->{source};
  93. }
  94. =item $c->get_pkg_by_idx($idx)
  95. Returns a Dpkg::Control object containing the fields concerning the binary
  96. package numbered $idx (starting at 1).
  97. =cut
  98. sub get_pkg_by_idx {
  99. my ($self, $idx) = @_;
  100. return $self->{packages}[--$idx];
  101. }
  102. =item $c->get_pkg_by_name($name)
  103. Returns a Dpkg::Control object containing the fields concerning the binary
  104. package named $name.
  105. =cut
  106. sub get_pkg_by_name {
  107. my ($self, $name) = @_;
  108. foreach my $pkg (@{$self->{packages}}) {
  109. return $pkg if ($pkg->{Package} eq $name);
  110. }
  111. return undef;
  112. }
  113. =item $c->get_packages()
  114. Returns a list containing the Dpkg::Control objects for all binary packages.
  115. =cut
  116. sub get_packages {
  117. my $self = shift;
  118. return @{$self->{packages}};
  119. }
  120. =item $c->output($filehandle)
  121. Dump the content into a filehandle.
  122. =cut
  123. sub output {
  124. my ($self, $fh) = @_;
  125. my $str;
  126. $str .= $self->{source}->output($fh);
  127. foreach my $pkg (@{$self->{packages}}) {
  128. print $fh "\n";
  129. $str .= "\n" . $pkg->output($fh);
  130. }
  131. return $str;
  132. }
  133. =item "$c"
  134. Return a string representation of the content.
  135. =item @{$c}
  136. Return a list of Dpkg::Control objects, the first one is corresponding to
  137. source information and the following ones are the binary packages
  138. information.
  139. =back
  140. =head1 AUTHOR
  141. Raphael Hertzog <hertzog@debian.org>.
  142. =cut
  143. 1;