modules/RpmSpecWorkspaceCreator.pm

   1 package RpmSpecWorkspaceCreator;
   2
   3 # ************************************************************
   4 # Description   : An RPM .spec file Workspace Creator
   5 # Author        : Adam Mitz (OCI)
   6 # Create Date   : 11/23/2010
   7 # ************************************************************
   8
   9 # ************************************************************
  10 # Pragmas
  11 # ************************************************************
  12
  13 use strict;
  14 use File::Path;
  15 use POSIX qw(strftime);
  16
  17 use RpmSpecProjectCreator;
  18 use WorkspaceCreator;
  19
  20 use vars qw(@ISA);
  21 @ISA = qw(WorkspaceCreator);
  22
  23 # ************************************************************
  24 # Data Section
  25 # ************************************************************
  26
  27 my $ext = '.spec'; # extension of files written by this WorkspaceCreator
  28
  29 # ************************************************************
  30 # Subroutine Section
  31 # ************************************************************
  32
  33 sub workspace_file_name {
  34   my $self = shift;
  35   return $self->get_modified_workspace_name($self->get_workspace_name(), $ext);
  36 }
  37
  38 # Called by document_template.pl
  39 sub documentation_info {
  40   shift; #ignore package name
  41   my $keywords = shift;
  42   %$keywords = ('apply' => \&interpret_keyword, 'cond' => \&interpret_keyword);
  43   return '^sub get_template', '^EOT$';
  44 }
  45
  46 sub default_verbose_ordering {
  47   return 1; # Warn if there are missing dependencies.
  48 }
  49
  50 # Called by document_template.pl
  51 sub interpret_keyword {
  52   my $vname = shift;
  53   $vname = (split /,/, $vname)[0];
  54   return ($vname, $vname, $vname, undef);
  55 }
  56
  57 # Don't actually write the .spec file for the workspace.  Instead just invoke
  58 # the $func callback so that post_workspace() and other parts of the normal
  59 # workspace processing are called.  We don't want a .spec file for each MPC
  60 # workspace because that is too course-grained.  Instead, post_workspace() will
  61 # create one .spec for each aggregated workspace inside the primary workspace.
  62 # Using the workspace aggregation mechanism this way allows multiple .spec
  63 # files per workspace with MPC deriving their dependencies based on the
  64 # projects they contain.
  65 sub write_and_compare_file {
  66   my($self, $outdir, $oname, $func, @params) = @_;
  67   &$func($self, undef, @params);
  68   return 1;
  69 }
  70
  71 sub rpmname {
  72   my($self, $mwc, $rpm2mwc, $check_unique) = @_;
  73   my $outfile = $mwc;
  74   $outfile =~ s/\.mwc$//i;
  75   $outfile = $self->get_modified_workspace_name($outfile, $ext, 1);
  76   my $base = $self->mpc_basename($outfile);
  77   $base =~ tr/-/_/; # - is special for RPM, we translate it to _
  78   if ($check_unique && $rpm2mwc->{$base}) {
  79     die "ERROR: Can't create a duplicate RPM name: $base for mwc file $mwc\n" .
  80         "\tsee corresponding mwc file $rpm2mwc->{$base}\n";
  81   }
  82   $rpm2mwc->{$base} = $mwc;
  83   return $base;
  84 }
  85
  86 ## helper functions for the mini-template language
  87
  88 sub mtl_cond {
  89   my($vars, $pre, $rep) = @_;
  90   my @v;
  91   return (@v = grep {$_} map {$rep->{lc $_}} split(' ', $vars)) ? "$pre@v" : '';
  92 }
  93
  94 sub mtl_apply {
  95   my($name, $subst, $rep) = @_;
  96   return join("\n", map {my $x = $subst; $x =~ s!\$_!$_!g; $x}
  97               split(' ', $rep->{lc $name}));
  98 }
  99
 100 sub mtl_var {
 101   my($name, $default, $rep) = @_;
 102   return defined $rep->{lc $name} ? $rep->{lc $name} :
 103       (defined $default ? $default : ">>ERROR: no value for $name<<");
 104 }
 105
 106 ## end helper functions for the mini-template language
 107
 108
 109 sub post_workspace {
 110   my($self, $fh, $prjc) = @_;
 111
 112   my $prjext = '\\' . # regexp escape for the dot that begins the extension
 113       $prjc->project_file_extension();
 114
 115   my %rpm2mwc;  # rpm name (basename of spec file) => aggregated mwc w/ path
 116   my %mwc2rpm;  # inverse of the above hash
 117   my %proj2rpm; # project name (output of mpc) => rpm name that it belongs to
 118   # first pass to build the hashes above
 119   foreach my $agg (keys %{$self->{'aggregated_mpc'}}) {
 120     my $rpm = $mwc2rpm{$agg} = $self->rpmname($agg, \%rpm2mwc, 1);
 121     foreach my $m (@{$self->{'aggregated_mpc'}->{$agg}}) {
 122       foreach my $p (@{$self->{'mpc_to_output'}->{$m}}) {
 123         $proj2rpm{$p} = $rpm;
 124       }
 125     }
 126   }
 127
 128   if (0 == scalar keys %proj2rpm) {
 129     # nothing to generate (no aggregated workspaces)
 130     return;
 131   }
 132
 133   my $outdir = $self->get_outdir();
 134   my $now = strftime '%a %b %d %Y %H:%M:%S', localtime;
 135
 136   my %assign = %{$self->get_assignment_hash()};
 137   $assign{'rpm_description'} =~ s/\\n\s*/\n/g  # Allow the description to span
 138       if exists $assign{'rpm_description'};    # multiple lines in the output
 139   map {$_ = $self->process_special($_)} values %assign;
 140
 141   # determine when this addtemp processing should actually occur
 142   while (my($key, $arr) = each %{$self->get_addtemp()}) {
 143     foreach my $val (@$arr) {
 144       my $v = $val->[1];
 145       $v =~ s/\\n\s*/\n/g if $key eq 'rpm_description';
 146       $v = $self->process_special($v);
 147       $self->process_any_assignment(\%assign, $val->[0], $key, $v);
 148     }
 149   }
 150
 151   foreach my $agg (keys %{$self->{'aggregated_mpc'}}) {
 152     my $name = "$outdir/$agg"; # $agg may contain directory parts
 153     my $dir  = $self->mpc_dirname($name);
 154     my $base = $mwc2rpm{$agg};
 155     my $rpm = $base;
 156     $rpm =~ s/$ext$//;
 157     $name = "$dir/$base";
 158     mkpath($dir, 0, 0777) if ($dir ne '.');
 159
 160     my %rpm_requires; # keys are RPMs that this RPM depends on
 161     my @projects;
 162     foreach my $m (@{$self->{'aggregated_mpc'}->{$agg}}) {
 163       my $projdir = $self->mpc_dirname($m);
 164       foreach my $p (@{$self->{'mpc_to_output'}->{$m}}) {
 165         my $proj = $p;
 166         $proj =~ s/$prjext$//;
 167         push @projects, $proj;
 168         my $deps = $self->get_validated_ordering("$projdir/$p");
 169         foreach my $d (@$deps) {
 170           my $rpmdep = $proj2rpm{$d};
 171           if (defined $rpmdep && $rpmdep ne $base) {
 172             $rpm_requires{$rpmdep} = 1;
 173           }
 174         }
 175       }
 176     }
 177
 178     # The hash %rep has replacement values for the template .spec file text,
 179     # those values come from a few different sources, starting with the
 180     # workspace-wide assignments, then let RPM-specific ones (from aggregated
 181     # workspaces) override those, and finally add the ones known by MPC.
 182     # process_special() handles quotes and escape characters.
 183
 184     my %rep = %assign;
 185
 186     while (my($key, $val) = each %{$self->{'aggregated_assign'}->{$agg}}) {
 187       $val =~ s/\\n\s*/\n/g if $key eq 'rpm_description';
 188       $rep{$key} = $self->process_special($val);
 189     }
 190
 191     $rep{'rpm_name'} = $rpm;
 192     $rep{'rpm_mpc_workspace'} = $self->mpc_basename($agg);
 193     $rep{'rpm_mpc_requires'} =
 194         join(' ', sort map {s/$ext$//; $_} keys %rpm_requires);
 195
 196     my $fh = new FileHandle;
 197     open $fh, ">$name" or die "can't open $name";
 198     my $t = get_template();
 199
 200     ## We have decided not to reuse the TemplateParser.pm, so this file has
 201     ## its own little template language which is a subset of that one.
 202
 203     ## <%cond(var1 [var2...], prefix)%>
 204     ##   Output the prefix text followed by the concatenated, space separated,
 205     ##   values of the variables (var1, var2, etc) only if at least one of
 206     ##   said values is non-empty.
 207     $t =~ s/<%cond\(([\w ]+), (.+)\)%>/mtl_cond($1, $2, \%rep)/ge;
 208
 209     ## <%perl(expr)%>
 210     ##   Evaluate an arbitrary perl expression, which can reference the normal
 211     ##   variable replacements (see <%var%>, below) as $rep{'name'}.
 212     $t =~ s/<%perl\((.+)\)%>/join "\n", eval $1/ge;
 213
 214     ## <%apply(listvar, text)%>
 215     ##   Treat the value of variable 'listvar' as a list (splitting on spaces)
 216     ##   and repeat the text for each element of the list, substituting $_ in
 217     ##   the text with the current list element.
 218     $t =~ s/<%apply\((\w+), (.+)\)%>/mtl_apply($1, $2, \%rep)/ge;
 219
 220     ## <%var(default)%> or <%var%>
 221     ##   Output the value of variable 'var', either with a default value or an
 222     ##   error if 'var' is unknown.  If 'default' is enclosed in double-quotes,
 223     ##   they are ignored (for compatibility with TemplateParser).
 224     $t =~ s/<%(\w+)(?:\("?([^)"]*)"?\))?%>/mtl_var($1, $2, \%rep)/ge;
 225
 226     print $fh $t;
 227
 228     # comment will go in the %changelog section of the .spec
 229     $self->print_workspace_comment($fh, map {$_ . "\n"} (
 230       "* $now This file was generated by MPC.",
 231       '  Any changes made directly to this file will',
 232       '  be lost the next time it is generated.',
 233       '  MPC Command:', '  ' . $self->create_command_line_string($0, @ARGV)));
 234     close $fh;
 235   }
 236
 237   # write the script to build .rpm files from .spec files
 238   my $fh = new FileHandle;
 239   my $name = $outdir . '/' . $self->{'workspace_name'} . '_rpm.sh';
 240   open($fh, ">$name") or die "can't open $name";
 241   print $fh "#!/bin/sh\n";
 242   $self->print_workspace_comment($fh, map {$_ . "\n"} (
 243     '# RPM creation script for MPC-generated .spec files.',
 244     "# $now",
 245     '# This file was generated by MPC.  Any changes made directly to',
 246     '# this file will be lost the next time it is generated.',
 247     '# MPC Command:', '# ' . $self->create_command_line_string($0, @ARGV)));
 248
 249   my $script = get_script();
 250   my $temporary = $assign{'rpm_mpc_temp'};
 251   $script =~ s!/tmp/mpcrpm!$temporary!g if defined $temporary;
 252   print $fh $script;
 253
 254   my %seen;
 255   foreach my $project ($self->sort_dependencies($self->get_projects(), 0)) {
 256     my $rpm = $proj2rpm{$self->mpc_basename($project)};
 257     next if !defined $rpm;
 258     if (!$seen{$rpm}) {
 259       $seen{$rpm} = 1;
 260       my $dir = $self->mpc_dirname($rpm2mwc{$rpm});
 261       $dir = ($dir eq '.' ? '' : "$dir/");
 262       print $fh "build $dir$rpm\n";
 263     }
 264   }
 265
 266   close $fh;
 267   chmod 0755, $name;
 268 }
 269
 270
 271 sub get_template {
 272   return <<'EOT';
 273 License: <%rpm_license("Freeware")%>
 274 Version: <%rpm_version%>
 275 Release: <%rpm_releasenumber%>
 276 Source: <%rpm_source_base("")%><%rpm_name%>.tar.gz
 277 Name: <%rpm_name%>
 278 Group: <%rpm_group%>
 279 Summary: <%rpm_summary%>
 280 <%cond(rpm_url, URL: )%>
 281 BuildRoot: %{_tmppath}/%{name}-%{version}-root
 282 Prefix: <%rpm_prefix("/usr")%>
 283 AutoReqProv: <%rpm_autorequiresprovides("no")%>
 284 <%cond(rpm_buildrequires, BuildRequires: )%>
 285 <%cond(rpm_mpc_requires rpm_requires, Requires: )%>
 286 <%cond(rpm_provides, Provides: )%>
 287
 288 %description
 289 <%rpm_description%>
 290
 291 %files -f %{_tmppath}/<%rpm_name%>.flist
 292 %defattr(-,root,root)
 293 %doc
 294 %config
 295
 296 %pre
 297 <%rpm_pre_cmd()%>
 298
 299 %post
 300 <%rpm_post_cmd()%>
 301
 302 %preun
 303 <%rpm_preun_cmd()%>
 304
 305 %postun
 306 <%rpm_postun_cmd()%>
 307
 308 %prep
 309 %setup -n <%rpm_name%>-<%rpm_version%>
 310
 311 %build
 312 <%apply(env_check, [ -z $$_ ] && echo Environment variable $_ is required. && exit 1)%>
 313 rm -rf $RPM_BUILD_ROOT
 314 <%prebuild()%>
 315 <%makefile_generator(mwc.pl -type gnuace)%> -base install -value_project libpaths+=<%rpm_mpc_temp(/tmp/mpcrpm)%>/inst/lib -value_project includes+=<%rpm_mpc_temp(/tmp/mpcrpm)%>/inst/include <%mkgen_args()%> <%rpm_mpc_workspace%>
 316 make <%makeflags()%>
 317
 318 %install
 319 if [ "$RPM_BUILD_ROOT" = "/" ]; then
 320   echo "Build root of / is a bad idea.  Bailing."
 321   exit 1
 322 fi
 323 rm -rf $RPM_BUILD_ROOT
 324 export staging_dir=$RPM_BUILD_ROOT/install<%rpm_prefix("/usr")%>
 325 mkdir -p $staging_dir
 326 export pkg_dir=$RPM_BUILD_ROOT/<%rpm_name%>_dir
 327 mkdir -p $RPM_BUILD_ROOT/<%rpm_name%>_dir
 328 make INSTALL_PREFIX=${staging_dir} install
 329 if [ -d ${staging_dir}/share/man ]; then
 330   files=$(find ${staging_dir}/share/man -name '*.bz2')
 331   if [[ "${files}" ]]; then echo "${files}" | xargs bunzip2 -q; fi
 332   files=$(find ${staging_dir}/share/man -name '*.[0-9]')
 333   if [[ "${files}" ]]; then echo "${files}" | xargs gzip -9; fi
 334 fi
 335 cp -a $RPM_BUILD_ROOT/install/* ${pkg_dir}
 336 find ${pkg_dir} ! -type d | sed s^${pkg_dir}^^ | sed /^\s*$/d > %{_tmppath}/<%rpm_name%>.flist
 337 find ${pkg_dir} -type d | sed s^${pkg_dir}^^ | sed '\&^/usr$&d;\&^/usr/share/man&d;\&^/usr/games$&d;\&^/lib$&d;\&^/etc$&d;\&^/boot$&d;\&^/usr/bin$&d;\&^/usr/lib$&d;\&^/usr/share$&d;\&^/var$&d;\&^/var/lib$&d;\&^/var/spool$&d;\&^/var/cache$&d;\&^/var/lock$&d;\&^/tmp/apkg&d' | sed /^\s*$/d | sed 's&^&%dir &' >> %{_tmppath}/<%rpm_name%>.flist
 338 cp -a $RPM_BUILD_ROOT/*_dir/* $RPM_BUILD_ROOT
 339 rm -rf $RPM_BUILD_ROOT/*_dir
 340 rm -rf $RPM_BUILD_ROOT/install
 341
 342 %clean
 343 make realclean
 344 find . -name '<%makefile_name_pattern(GNUmakefile*)%>' -o -name '.depend.*' | xargs rm -f
 345
 346 %changelog
 347 EOT
 348 }
 349
 350
 351 sub get_script {
 352   return <<'EOT';
 353 RPM_TOP=`rpmbuild --showrc | grep ': _topdir\b' | sed 's/^.*: _topdir\s*//' | perl -pe's/%{getenv:(\w+)}/$ENV{$1}/g'`
 354 START_DIR=`pwd`
 355 TMP_DIR=/tmp/mpcrpm
 356 DB_DIR=`rpmbuild --showrc | grep ': _dbpath\b' | sed 's/^.*: _dbpath\s*//' | perl -pe's/%\{(\w+)\}/$x = qx(rpmbuild --showrc | grep ": $1\\\b" | sed "s\/^.*: $1\\\s*\/\/"); chomp $x; $x/e'`
 357 RPM_ARCH=${1-`uname -m`}
 358 echo MPC RPM build script: output files will be placed in $RPM_TOP/RPMS
 359 [ -z $MPC_ROOT ] && echo ERROR: MPC_ROOT must be set && exit 1
 360 rm -rf $TMP_DIR && mkdir $TMP_DIR && cp -a $DB_DIR $TMP_DIR/db || exit $?
 361
 362 build () {
 363   [ ! -r $1 ] && echo ERROR: File not found $1 && exit 1
 364   PKG_DIR=`dirname $1`
 365   PKG=`basename ${1%.spec}`
 366   cd $PKG_DIR
 367   VER=`grep ^Version: $PKG.spec | sed 's/^Version: //'`
 368   REL=`grep ^Release: $PKG.spec | sed 's/^Release: //'`
 369   echo Building source .tar.gz for $PKG version $VER release $REL
 370   rm -rf $TMP_DIR/$PKG-$VER
 371   $MPC_ROOT/clone_build_tree.pl -b $TMP_DIR $PKG-$VER > /dev/null
 372   cd $TMP_DIR
 373   tar chzf $RPM_TOP/SOURCES/$PKG.tar.gz $PKG-$VER && rm -rf $PKG-$VER
 374   cp $START_DIR/$PKG_DIR/$PKG.spec $RPM_TOP/SPECS
 375   echo Running rpmbuild on $PKG.spec for arch $RPM_ARCH, see rpm-$PKG.log for details
 376   rpmbuild -ba --target $RPM_ARCH $RPM_TOP/SPECS/$PKG.spec > $START_DIR/rpm-$PKG.log 2>&1
 377   if [ $? != 0 ]; then
 378     echo rpmbuild of $PKG.spec failed. STOPPING.
 379     exit $?
 380   fi
 381   echo Installing $PKG to the temporary area
 382   rpm --ignorearch --dbpath $TMP_DIR/db --prefix $TMP_DIR/inst -iv $RPM_TOP/RPMS/$RPM_ARCH/$PKG-$VER-$REL.$RPM_ARCH.rpm || exit $?
 383   cd $START_DIR
 384 }
 385
 386 EOT
 387 }
 388
 389 1;