Info.pm 4.0 KB

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