Info.pm 4.0 KB

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