Info.pm 4.0 KB

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