home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / Dpkg / Conf.pm < prev    next >
Encoding:
Perl POD Document  |  2012-09-17  |  4.1 KB  |  185 lines
  1. # Copyright ┬⌐ 2009-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.  
  16. package Dpkg::Conf;
  17.  
  18. use strict;
  19. use warnings;
  20.  
  21. our $VERSION = "1.01";
  22.  
  23. use Dpkg::Gettext;
  24. use Dpkg::ErrorHandling;
  25.  
  26. use base qw(Dpkg::Interface::Storable);
  27.  
  28. use overload
  29.     '@{}' => sub { return [ $_[0]->get_options() ] },
  30.     fallback => 1;
  31.  
  32. =encoding utf8
  33.  
  34. =head1 NAME
  35.  
  36. Dpkg::Conf - parse dpkg configuration files
  37.  
  38. =head1 DESCRIPTION
  39.  
  40. The Dpkg::Conf object can be used to read options from a configuration
  41. file. It can exports an array that can then be parsed exactly like @ARGV.
  42.  
  43. =head1 FUNCTIONS
  44.  
  45. =over 4
  46.  
  47. =item my $conf = Dpkg::Conf->new(%opts)
  48.  
  49. Create a new Dpkg::Conf object. Some options can be set through %opts:
  50. if allow_short evaluates to true (it defaults to false), then short
  51. options are allowed in the configuration file, they should be prepended
  52. with a single dash.
  53.  
  54. =cut
  55.  
  56. sub new {
  57.     my ($this, %opts) = @_;
  58.     my $class = ref($this) || $this;
  59.  
  60.     my $self = {
  61.     options => [],
  62.     allow_short => 0,
  63.     };
  64.     foreach my $opt (keys %opts) {
  65.     $self->{$opt} = $opts{$opt};
  66.     }
  67.     bless $self, $class;
  68.  
  69.     return $self;
  70. }
  71.  
  72. =item @$conf
  73.  
  74. =item @options = $conf->get_options()
  75.  
  76. Returns the list of options that can be parsed like @ARGV.
  77.  
  78. =cut
  79.  
  80. sub get_options {
  81.     my ($self) = @_;
  82.     return @{$self->{'options'}};
  83. }
  84.  
  85. =item $conf->load($file)
  86.  
  87. Read options from a file. Return the number of options parsed.
  88.  
  89. =item $conf->parse($fh)
  90.  
  91. Parse options from a file handle. Return the number of options parsed.
  92.  
  93. =cut
  94.  
  95. sub parse {
  96.     my ($self, $fh, $desc) = @_;
  97.     my $count = 0;
  98.     while (<$fh>) {
  99.     chomp;
  100.     s/^\s+//; s/\s+$//;   # Strip leading/trailing spaces
  101.     s/\s+=\s+/=/;         # Remove spaces around the first =
  102.     s/\s+/=/ unless m/=/; # First spaces becomes = if no =
  103.     next if /^#/ or /^$/; # Skip empty lines and comments
  104.     if (/^-[^-]/ and not $self->{'allow_short'}) {
  105.         warning(_g("short option not allowed in %s, line %d"), $desc, $.);
  106.         next;
  107.     }
  108.     if (/^([^=]+)(?:=(.*))?$/) {
  109.         my ($name, $value) = ($1, $2);
  110.         $name = "--$name" unless $name =~ /^-/;
  111.         if (defined $value) {
  112.         $value =~ s/^"(.*)"$/$1/ or $value =~ s/^'(.*)'$/$1/;
  113.         push @{$self->{'options'}}, "$name=$value";
  114.         } else {
  115.         push @{$self->{'options'}}, $name;
  116.         }
  117.         $count++;
  118.     } else {
  119.         warning(_g("invalid syntax for option in %s, line %d"), $desc, $.);
  120.     }
  121.     }
  122.     return $count;
  123. }
  124.  
  125. =item $conf->filter(remove => $rmfunc)
  126.  
  127. =item $conf->filter(keep => $keepfunc)
  128.  
  129. Filter the list of options, either removing or keeping all those that
  130. return true when &$rmfunc($option) or &keepfunc($option) is called.
  131.  
  132. =cut
  133.  
  134. sub filter {
  135.     my ($self, %opts) = @_;
  136.     if (defined($opts{'remove'})) {
  137.     @{$self->{'options'}} = grep { not &{$opts{'remove'}}($_) }
  138.                      @{$self->{'options'}};
  139.     }
  140.     if (defined($opts{'keep'})) {
  141.     @{$self->{'options'}} = grep { &{$opts{'keep'}}($_) }
  142.                      @{$self->{'options'}};
  143.     }
  144. }
  145.  
  146. =item $string = $conf->output($fh)
  147.  
  148. Write the options in the given filehandle (if defined) and return a string
  149. representation of the content (that would be) written.
  150.  
  151. =item "$conf"
  152.  
  153. Return a string representation of the content.
  154.  
  155. =item $conf->save($file)
  156.  
  157. Save the options in a file.
  158.  
  159. =cut
  160.  
  161. sub output {
  162.     my ($self, $fh) = @_;
  163.     my $ret = "";
  164.     foreach my $opt ($self->get_options()) {
  165.     $opt =~ s/^--//;
  166.     if ($opt =~ s/^([^=]+)=/$1 = "/) {
  167.         $opt .= '"';
  168.     }
  169.     $opt .= "\n";
  170.     print $fh $opt if defined $fh;
  171.     $ret .= $opt;
  172.     }
  173.     return $ret;
  174. }
  175.  
  176. =back
  177.  
  178. =head1 AUTHOR
  179.  
  180. Rapha├½l Hertzog <hertzog@debian.org>.
  181.  
  182. =cut
  183.  
  184. 1;
  185.