home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / share / perl5 / Binfmt / Format.pm next >
Encoding:
Perl POD Document  |  2006-06-19  |  3.8 KB  |  152 lines
  1. package Binfmt::Format;
  2.  
  3. # Copyright (c) 2000, 2001, 2002 Colin Watson <cjwatson@debian.org>.
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or
  8. # (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. # GNU General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  18.  
  19. # There are no published interfaces here. If you base code outside
  20. # binfmt-support on this package, it may be broken at any time.
  21.  
  22. use strict;
  23.  
  24. use Errno qw(ENOENT);
  25. use Binfmt::Lib qw(quit warning);
  26.  
  27. my @fields = qw(package type offset magic mask interpreter);
  28. my @optional_fields = qw(detector);
  29.  
  30. sub load ($$$)
  31. {
  32.     my $class = shift;
  33.     my $name = shift;
  34.     my $filename = shift;
  35.     my $self = {name => $name};
  36.     local *BINFMT;
  37.     open BINFMT, "< $filename" or quit "unable to open $filename: $!";
  38.     for my $field (@fields) {
  39.     $self->{$field} = <BINFMT>;
  40.     quit "$filename corrupt: out of binfmt data reading $field"
  41.         unless defined $self->{$field};
  42.     }
  43.     for my $field (@optional_fields) {
  44.     $self->{$field} = <BINFMT>;
  45.     $self->{$field} = '' unless defined $self->{$field};
  46.     }
  47.     close BINFMT;
  48.     chomp $self->{$_} for keys %$self;
  49.     return bless $self, $class;
  50. }
  51.  
  52. sub new ($$%)
  53. {
  54.     my $class = shift;
  55.     my $name = shift;
  56.     my $self = {name => $name};
  57.     while (@_) {    # odd number of arguments => last value undef
  58.     my $key = shift;
  59.     my $value = shift;
  60.     # $value may be undef, as update-binfmts' parser is simpler that way.
  61.     if (defined $value and $value =~ /\n/) {
  62.         quit "newlines prohibited in binfmt files ($value)";
  63.     }
  64.     $self->{$key} = $value;
  65.     }
  66.  
  67.     unless (defined $self->{type}) {
  68.     if (defined $self->{magic}) {
  69.         if (defined $self->{extension}) {
  70.         warning "$name: can't use both --magic and --extension";
  71.         return undef;
  72.         } else {
  73.         $self->{type} = 'magic';
  74.         }
  75.     } else {
  76.         if (defined $self->{extension}) {
  77.         $self->{type} = 'extension';
  78.         } else {
  79.         warning "$name: either --magic or --extension is required";
  80.         return undef;
  81.         }
  82.     }
  83.     }
  84.  
  85.     if ($self->{type} eq 'extension') {
  86.     $self->{magic} = $self->{extension};
  87.     if (defined $self->{mask}) {
  88.         warning "$name: can't use --mask with --extension";
  89.         return undef;
  90.     }
  91.     if (defined $self->{offset}) {
  92.         warning "$name: can't use --offset with --extension";
  93.         return undef;
  94.     }
  95.     }
  96.     delete $self->{extension};
  97.  
  98.     $self->{mask} = '' unless defined $self->{mask};
  99.     $self->{offset} ||= 0;
  100.  
  101.     return bless $self, $class;
  102. }
  103.  
  104. sub write ($;$)
  105. {
  106.     my $self = shift;
  107.     my $filename = shift;
  108.  
  109.     unless (unlink $filename) {
  110.     if ($! != ENOENT) {
  111.         warning "unable to ensure $filename nonexistent: $!";
  112.         return 0;
  113.     }
  114.     }
  115.     local *BINFMT;
  116.     unless (open BINFMT, "> $filename") {
  117.     warning "unable to open $filename for writing: $!";
  118.     return 0;
  119.     }
  120.  
  121.     for my $field (@fields, @optional_fields) {
  122.     print BINFMT (defined ($self->{$field}) ? $self->{$field} : ''), "\n";
  123.     }
  124.  
  125.     unless (close BINFMT) {
  126.     warning "unable to close $filename: $!";
  127.     return 0;
  128.     }
  129.  
  130.     return 1;
  131. }
  132.  
  133. sub dump_stdout ($)
  134. {
  135.     my $self = shift;
  136.     for my $field (@fields, @optional_fields) {
  137.     printf "%12s = %s\n", $field, $self->{$field};
  138.     }
  139. }
  140.  
  141. sub equals ($$)
  142. {
  143.     my $self = shift;
  144.     my $other = shift;
  145.     for my $field (qw(type offset magic mask)) {
  146.     return 0 if $self->{$field} ne $other->{$field};
  147.     }
  148.     return 1;
  149. }
  150.  
  151. 1;
  152.