home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / boot / i386 / rescue / usr / lib / rpm / Specfile.pm < prev    next >
Encoding:
Perl POD Document  |  2006-11-29  |  3.6 KB  |  194 lines
  1. package RPM::Specfile;
  2.  
  3. use POSIX;
  4.  
  5. use strict;
  6.  
  7. use vars qw/$VERSION/;
  8.  
  9. $VERSION = '1.02';
  10.  
  11. sub new {
  12.   my $class = shift;
  13.  
  14.   my $self = bless { }, $class;
  15.  
  16.   return $self;
  17. }
  18.  
  19. my @simple_accessors = qw/name version release epoch license group url description prep build clean install summary buildroot buildrequires file_param packager vendor distribution buildarch/;
  20.  
  21. foreach my $field (@simple_accessors) {
  22.   my $sub = q {
  23.     sub RPM::Specfile::[[field]] {
  24.       my $self = shift;
  25.       if (@_) {
  26.         my $value = shift;
  27.         $self->{__[[field]]__} = $value;
  28.       }
  29.       return $self->{__[[field]]__};
  30.     }
  31.   };
  32.  
  33.   $sub =~ s/\[\[field\]\]/$field/g;
  34.   eval $sub;
  35.  
  36.   if ($@) {
  37.     die $@;
  38.   }
  39. }
  40.  
  41. my @array_accessors = qw/source patch changelog provide require file/;
  42.  
  43. foreach my $field (@array_accessors) {
  44.   my $sub = q {
  45.     sub RPM::Specfile::[[field]] {
  46.       my $self = shift;
  47.       $self->{__[[field]]__} ||= [ ];
  48.  
  49.       if (@_) {
  50.         my $index = shift;
  51.         if (@_) {
  52.           my $value = shift;
  53.           $self->{__[[field]]__}->[$index] = $value;
  54.         }
  55.         return $self->{__[[field]]__}->[$index];
  56.       }
  57.       else {
  58.         return @{$self->{__[[field]]__}};
  59.       }
  60.     }
  61.  
  62.     sub RPM::Specfile::push_[[field]] {
  63.       my $self = shift;
  64.       my $entry = shift;
  65.  
  66.       $self->{__[[field]]__} ||= [ ];
  67.       push @{$self->{__[[field]]__}}, $entry;
  68.     }
  69.  
  70.     sub RPM::Specfile::clear_[[field]] {
  71.       my $self = shift;
  72.       my $entry = shift;
  73.  
  74.       $self->{__[[field]]__} = [ ];
  75.     }
  76.  
  77.   };
  78.  
  79.   $sub =~ s/\[\[field\]\]/$field/g;
  80.   eval $sub;
  81.  
  82.   if ($@) {
  83.     die $@;
  84.   }
  85. }
  86.  
  87. sub add_changelog_entry {
  88.   my $self = shift;
  89.   my $who = shift;
  90.   my $entry = shift;
  91.  
  92.   my $output;
  93.   $output .= strftime("* %a %b %d %Y $who\n", localtime time);
  94.   $output .= "- $entry\n";
  95.  
  96.   $self->push_changelog($output);
  97. }
  98.  
  99. sub generate_specfile {
  100.   my $self = shift;
  101.  
  102.   my $output;
  103.  
  104.   my %defaults = ( buildroot => "%{_tmppath}/%{name}-root" );
  105.   $self->$_($self->$_() || $defaults{$_}) foreach keys %defaults;
  106.  
  107.   my %proper_names = ( url => "URL", buildroot => "BuildRoot", "buildrequires" => "BuildRequires" );
  108.  
  109.   foreach my $tag (qw/name version release epoch packager vendor distribution summary license group url buildroot buildrequires buildarch/) {
  110.     my $proper = $proper_names{$tag} || ucfirst $tag;
  111.  
  112.     next unless defined $self->$tag();
  113.     $output .= "$proper: " . $self->$tag() . "\n";
  114.   }
  115.  
  116.   my @reqs = $self->require;
  117.   for my $i (0 .. $#reqs) {
  118.     $output .= "Requires: $reqs[$i]\n";
  119.   }
  120.  
  121.   my @sources = $self->source;
  122.   for my $i (0 .. $#sources) {
  123.     $output .= "Source$i: $sources[$i]\n";
  124.   }
  125.  
  126.   my @patches = $self->patch;
  127.   for my $i (0 .. $#patches) {
  128.     $output .= "Patch$i: $patches[$i]\n";
  129.   }
  130.  
  131.   $output .= "\n";
  132.  
  133.   foreach my $sect (qw/description prep build clean install/) {
  134.     $output .= "%$sect\n";
  135.     $output .= $self->$sect() . "\n";
  136.   }
  137.  
  138.   if ($self->file_param) {
  139.     $output .= "%files " . $self->file_param . "\n";
  140.   }
  141.   else {
  142.     $output .= "%files\n";
  143.   }
  144.   $output .= "$_\n" foreach $self->file;
  145.  
  146.   $output .= "\n%changelog\n";
  147.   $output .= "$_\n" foreach $self->changelog;
  148.  
  149.   return $output;
  150. }
  151.  
  152. sub write_specfile {
  153.   my $self = shift;
  154.   my $dest = shift;
  155.  
  156.   open FH, ">$dest"
  157.     or die "Can't open $dest: $!";
  158.  
  159.   print FH $self->generate_specfile;
  160.  
  161.   close FH;
  162. }
  163.  
  164. 1;
  165.  
  166. __END__
  167. # Below is stub documentation for your module. You better edit it!
  168.  
  169. =head1 NAME
  170.  
  171. RPM::Specfile - Perl extension for creating RPM Specfiles
  172.  
  173. =head1 SYNOPSIS
  174.  
  175.   use RPM::Specfile;
  176.  
  177. =head1 DESCRIPTION
  178.  
  179. Simple module for creation of RPM Spec files
  180.  
  181. =head2 EXPORT
  182.  
  183. None by default.
  184.  
  185. =head1 AUTHOR
  186.  
  187. Chip Turner <cturner@redhat.com>
  188.  
  189. =head1 SEE ALSO
  190.  
  191. L<perl>.
  192.  
  193. =cut
  194.