Changeset 395 in ProjectBuilder for devel/pb/lib
- Timestamp:
- Apr 18, 2008, 7:32:09 PM (16 years ago)
- Location:
- devel/pb/lib/ProjectBuilder
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
devel/pb/lib/ProjectBuilder/Base.pm
r383 r395 1 1 #!/usr/bin/perl -w 2 2 # 3 # Base subroutines for the Project-Builder project 3 # Base subroutines brought by the the Project-Builder project 4 # which can be easily used by whatever perl project 5 # 6 # Copyright B. Cornec 2007-2008 7 # Provided under the GPL v2 4 8 # 5 9 # $Id$ … … 10 14 use strict; 11 15 use lib qw (lib); 12 use File::Basename;13 16 use File::Path; 14 use File::stat;15 use File::Copy;16 17 use File::Temp qw(tempdir); 17 18 use Data::Dumper; 18 use POSIX qw(strftime);19 19 use Time::localtime qw(localtime); 20 use Date::Manip;21 20 use English; 22 21 … … 32 31 33 32 our @ISA = qw(Exporter); 34 our @EXPORT = qw(pb_env_init pb_conf_read pb_conf_read_if pb_conf_get pb_conf_get_if pb_cms_init pb_mkdir_p pb_system pb_rm_rf pb_get_filters pb_filter_file pb_filter_file_pb pb_filter_file_inplace pb_cms_export pb_cms_log pb_cms_isdiff pb_cms_copy pb_cms_checkout pb_cms_up pb_cms_checkin pb_get_date pb_log pb_log_init pb_get_pkg pb_cms_get_pkg pb_get_uri pb_cms_get_uri $debug $LOG); 35 36 sub pb_env_init { 37 38 my $proj=shift || undef; 39 my $pbinit=shift || undef; 40 my $action=shift; 41 my $ver; 42 my $tag; 43 44 $ENV{'PBETC'} = "$ENV{'HOME'}/.pbrc"; 45 46 # 47 # Check project name 48 # Could be with env var PBPROJ 49 # or option -p 50 # if not define take the first in conf file 51 # 52 if ((defined $ENV{'PBPROJ'}) && 53 (not (defined $proj))) { 54 $proj = $ENV{'PBPROJ'}; 55 } 56 57 # 58 # We get the pbconf file for that project 59 # and use its content 60 # 61 my ($pbconf) = pb_conf_read("$ENV{'PBETC'}","pbconfurl"); 62 pb_log(2,"DEBUG pbconfurl: ".Dumper($pbconf)."\n"); 63 64 my %pbconf = %$pbconf; 65 if (not defined $proj) { 66 # Take the first as the default project 67 $proj = (keys %pbconf)[0]; 68 if (defined $proj) { 69 pb_log(1,"WARNING: using $proj as default project as none has been specified\n"); 70 pb_log(1," Please either create a pbconfurl reference for project $proj in $ENV{'PBETC'}\n"); 71 pb_log(1," or call pb with the -p project option or use the env var PBPROJ\n"); 72 pb_log(1," if you want to use another project\n"); 73 } 74 } 75 die "No project defined - use env var PBPROJ or -p proj or a pbconfurl entry in $ENV{'PBETC'}" if (not (defined $proj)); 76 77 # That's always the environment variable that will be used 78 $ENV{'PBPROJ'} = $proj; 79 pb_log(2,"PBPROJ: $ENV{'PBPROJ'}\n"); 80 81 if (not defined ($pbconf{$ENV{'PBPROJ'}})) { 82 die "Please create a pbconfurl reference for project $ENV{'PBPROJ'} in $ENV{'PBETC'}\n"; 83 } 84 85 # 86 # Detect the root dir for hosting all the content generated with pb 87 # 88 # Tree will look like this: 89 # 90 # maint pbdefdir PBDEFDIR dev dir (optional) 91 # | | 92 # ------------------------ -------------------- 93 # | | | | 94 # pbproj1 pbproj2 PBPROJ pbproj1 pbproj2 PBPROJDIR 95 # | | 96 # --------------------------------------------- ---------- 97 # * * * | | | * * 98 # tag dev pbconf ... build delivery PBCONFDIR dev tag 99 # | | | PBDESTDIR | 100 # --- ------ pbrc PBBUILDDIR ------- 101 # | | | | | 102 # 1.1 dev tag 1.0 1.1 PBDIR 103 # | 104 # ------- 105 # | | 106 # 1.0 1.1 PBROOTDIR 107 # | 108 # ---------------------------------- 109 # | | | | 110 # pkg1 pbproj1.pb pbfilter pbcl 111 # | 112 # ----------------- 113 # | | | 114 # rpm deb pbfilter 115 # 116 # 117 # (*) By default, if no relocation in .pbrc, dev dir is taken in the maint pbdefdir (when appropriate) 118 # Names under a pbproj and the corresponding pbconf should be similar 119 # 120 121 my ($pbdefdir) = pb_conf_get_if("pbdefdir"); 122 123 if (not defined $ENV{'PBDEFDIR'}) { 124 if ((not defined $pbdefdir) || (not defined $pbdefdir->{$ENV{'PBPROJ'}})) { 125 pb_log(1,"WARNING: no pbdefdir defined, using /var/cache\n"); 126 pb_log(1," Please create a pbdefdir reference for project $ENV{'PBPROJ'} in $ENV{'PBETC'}\n"); 127 pb_log(1," if you want to use another directory\n"); 128 $ENV{'PBDEFDIR'} = "/var/cache"; 129 } else { 130 # That's always the environment variable that will be used 131 $ENV{'PBDEFDIR'} = $pbdefdir->{$ENV{'PBPROJ'}}; 132 } 133 } 134 # Expand potential env variable in it 135 eval { $ENV{'PBDEFDIR'} =~ s/(\$ENV.+\})/$1/eeg }; 136 137 pb_log(2,"PBDEFDIR: $ENV{'PBDEFDIR'}\n"); 138 # 139 # Set delivery directory 140 # 141 $ENV{'PBDESTDIR'}="$ENV{'PBDEFDIR'}/$ENV{'PBPROJ'}/delivery"; 142 143 pb_log(2,"PBDESTDIR: $ENV{'PBDESTDIR'}\n"); 144 # 145 # Removes all directory existing below the delivery dir 146 # as they are temp dir only 147 # Files stay and have to be cleaned up manually if needed 148 # those files serves as communication channels between pb phases 149 # Removing them prevents a following phase to detect what has been done before 150 # 151 if (-d $ENV{'PBDESTDIR'}) { 152 opendir(DIR,$ENV{'PBDESTDIR'}) || die "Unable to open directory $ENV{'PBDESTDIR'}: $!"; 153 foreach my $d (readdir(DIR)) { 154 next if ($d =~ /^\./); 155 next if (-f "$ENV{'PBDESTDIR'}/$d"); 156 pb_rm_rf("$ENV{'PBDESTDIR'}/$d") if (-d "$ENV{'PBDESTDIR'}/$d"); 157 } 158 closedir(DIR); 159 } 160 if (! -d "$ENV{'PBDESTDIR'}") { 161 pb_mkdir_p($ENV{'PBDESTDIR'}) || die "Unable to recursively create $ENV{'PBDESTDIR'}"; 162 } 163 164 # 165 # Set build directory 166 # 167 $ENV{'PBBUILDDIR'}="$ENV{'PBDEFDIR'}/$ENV{'PBPROJ'}/build"; 168 if (! -d "$ENV{'PBBUILDDIR'}") { 169 pb_mkdir_p($ENV{'PBBUILDDIR'}) || die "Unable to recursively create $ENV{'PBBUILDDIR'}"; 170 } 171 172 pb_log(2,"PBBUILDDIR: $ENV{'PBBUILDDIR'}\n"); 173 # 174 # Set temp directory 175 # 176 if (not defined $ENV{'TMPDIR'}) { 177 $ENV{'TMPDIR'}="/tmp"; 178 } 179 $ENV{'PBTMP'} = tempdir( "pb.XXXXXXXXXX", DIR => $ENV{'TMPDIR'}, CLEANUP => 1 ); 180 pb_log(2,"PBTMP: $ENV{'PBTMP'}\n"); 181 182 # 183 # The following part is only useful when in cms2something of newver 184 # In VMs/VEs we want to skip that by providing good env vars. 185 # return values in that case are useless 186 # 187 if (($action =~ /^cms2/) || ($action =~ /^newver$/)) { 188 189 # 190 # Check pbconf cms compliance 191 # 192 pb_cms_compliant("pbconfdir",'PBCONFDIR',"$ENV{'PBDEFDIR'}/$ENV{'PBPROJ'}/pbconf",$pbconf{$ENV{'PBPROJ'}},$pbinit); 193 194 # Check where is our PBROOTDIR (release tag name can't be guessed the first time) 195 # 196 if (not defined $ENV{'PBROOTDIR'}) { 197 if (! -f ("$ENV{'PBDESTDIR'}/pbrc")) { 198 opendir(DIR,$ENV{'PBCONFDIR'}) || die "Unable to open directory $ENV{'PBCONFDIR'}: $!"; 199 my $maxmtime = 0; 200 foreach my $d (readdir(DIR)) { 201 pb_log(3,"Looking at \'$d\'..."); 202 next if ($d =~ /^\./); 203 next if (! -d "$ENV{'PBCONFDIR'}/$d"); 204 my $s = stat("$ENV{'PBCONFDIR'}/$d"); 205 next if (not defined $s); 206 pb_log(3,"KEEP\n"); 207 # Keep the most recent 208 pb_log(2," $s->mtime\n"); 209 if ($s->mtime > $maxmtime) { 210 $ENV{'PBROOTDIR'} = "$ENV{'PBCONFDIR'}/$d"; 211 $maxmtime = $s->mtime; 212 } 213 } 214 closedir(DIR); 215 die "No directory found under $ENV{'PBCONFDIR'}" if (not defined $ENV{'PBROOTDIR'}); 216 pb_log(1,"WARNING: no pbroot defined, using $ENV{'PBROOTDIR'}\n"); 217 pb_log(1," Please use -r release if you want to use another release\n"); 218 } else { 219 my ($pbroot) = pb_conf_read_if("$ENV{'PBDESTDIR'}/pbrc","pbroot"); 220 # That's always the environment variable that will be used 221 die "Please remove inconsistent $ENV{'PBDESTDIR'}/pbrc" if ((not defined $pbroot) || (not defined $pbroot->{$ENV{'PBPROJ'}})); 222 $ENV{'PBROOTDIR'} = $pbroot->{$ENV{'PBPROJ'}}; 223 } 224 } else { 225 # transform in full path if relative 226 $ENV{'PBROOTDIR'} = "$ENV{'PBCONFDIR'}/$ENV{'PBROOTDIR'}" if ($ENV{'PBROOTDIR'} !~ /^\//); 227 pb_mkdir_p($ENV{'PBROOTDIR'}) if (defined $pbinit); 228 die "$ENV{'PBROOTDIR'} is not a directory" if (not -d $ENV{'PBROOTDIR'}); 229 } 230 231 return if ($action =~ /^newver$/); 232 233 my %version = (); 234 my %defpkgdir = (); 235 my %extpkgdir = (); 236 my %filteredfiles = (); 237 my %supfiles = (); 238 239 if ((-f "$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb") and (not defined $pbinit)) { 240 # List of pkg to build by default (mandatory) 241 my ($defpkgdir,$pbpackager, $pkgv, $pkgt) = pb_conf_get("defpkgdir","pbpackager","projver","projtag"); 242 # List of additional pkg to build when all is called (optional) 243 # Valid version names (optional) 244 # List of files to filter (optional) 245 # Project version and tag (optional) 246 my ($extpkgdir, $version, $filteredfiles, $supfiles) = pb_conf_get_if("extpkgdir","version","filteredfiles","supfiles"); 247 pb_log(2,"DEBUG: defpkgdir: ".Dumper($defpkgdir)."\n"); 248 pb_log(2,"DEBUG: extpkgdir: ".Dumper($extpkgdir)."\n"); 249 pb_log(2,"DEBUG: version: ".Dumper($version)."\n"); 250 pb_log(2,"DEBUG: filteredfiles: ".Dumper($filteredfiles)."\n"); 251 pb_log(2,"DEBUG: supfiles: ".Dumper($supfiles)."\n"); 252 # Global 253 %defpkgdir = %$defpkgdir; 254 %extpkgdir = %$extpkgdir if (defined $extpkgdir); 255 %version = %$version if (defined $version); 256 %filteredfiles = %$filteredfiles if (defined $filteredfiles); 257 %supfiles = %$supfiles if (defined $supfiles); 258 # 259 # Get global Version/Tag 260 # 261 if (not defined $ENV{'PBPROJVER'}) { 262 if ((defined $pkgv) && (defined $pkgv->{$ENV{'PBPROJ'}})) { 263 $ENV{'PBPROJVER'}=$pkgv->{$ENV{'PBPROJ'}}; 264 } else { 265 die "No projver found in $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb"; 266 } 267 } 268 die "Invalid version name $ENV{'PBPROJVER'} in $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb" if (($ENV{'PBPROJVER'} !~ /[0-9.]+/) && (not defined $version) && ($ENV{'PBPROJVER'} =~ /$version{$ENV{'PBPROJ'}}/)); 269 270 if (not defined $ENV{'PBPROJTAG'}) { 271 if ((defined $pkgt) && (defined $pkgt->{$ENV{'PBPROJ'}})) { 272 $ENV{'PBPROJTAG'}=$pkgt->{$ENV{'PBPROJ'}}; 273 } else { 274 die "No projtag found in $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb"; 275 } 276 } 277 die "Invalid tag name $ENV{'PBPROJTAG'} in $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb" if ($ENV{'PBPROJTAG'} !~ /[0-9.]+/); 278 279 280 if (not defined $ENV{'PBPACKAGER'}) { 281 if ((defined $pbpackager) && (defined $pbpackager->{$ENV{'PBPROJ'}})) { 282 $ENV{'PBPACKAGER'}=$pbpackager->{$ENV{'PBPROJ'}}; 283 } else { 284 die "No pbpackager found in $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb"; 285 } 286 } 287 } else { 288 if (defined $pbinit) { 289 my $ptr = pb_get_pkg(); 290 my @pkgs = @$ptr; 291 @pkgs = ("pkg1") if (not @pkgs); 292 293 open(CONF,"> $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb") || die "Unable to create $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb"; 294 print CONF << "EOF"; 295 # 296 # Project Builder configuration file 297 # For project $ENV{'PBPROJ'} 298 # 299 # \$Id\$ 300 # 301 302 # 303 # What is the project URL 304 # 305 #pburl $ENV{'PBPROJ'} = svn://svn.$ENV{'PBPROJ'}.org/$ENV{'PBPROJ'}/devel 306 #pburl $ENV{'PBPROJ'} = svn://svn+ssh.$ENV{'PBPROJ'}.org/$ENV{'PBPROJ'}/devel 307 #pburl $ENV{'PBPROJ'} = cvs://cvs.$ENV{'PBPROJ'}.org/$ENV{'PBPROJ'}/devel 308 #pburl $ENV{'PBPROJ'} = http://www.$ENV{'PBPROJ'}.org/src/$ENV{'PBPROJ'}-devel.tar.gz 309 #pburl $ENV{'PBPROJ'} = ftp://ftp.$ENV{'PBPROJ'}.org/src/$ENV{'PBPROJ'}-devel.tar.gz 310 #pburl $ENV{'PBPROJ'} = file:///src/$ENV{'PBPROJ'}-devel.tar.gz 311 #pburl $ENV{'PBPROJ'} = dir:///src/$ENV{'PBPROJ'}-devel 312 313 # Check whether project is well formed 314 # (containing already a directory with the project-version name) 315 #pbwf $ENV{'PBPROJ'} = 1 316 317 # 318 # Packager label 319 # 320 #pbpackager $ENV{'PBPROJ'} = William Porte <bill\@$ENV{'PBPROJ'}.org> 321 # 322 323 # For delivery to a machine by SSH (potentially the FTP server) 324 # Needs hostname, account and directory 325 # 326 #sshhost $ENV{'PBPROJ'} = www.$ENV{'PBPROJ'}.org 327 #sshlogin $ENV{'PBPROJ'} = bill 328 #sshdir $ENV{'PBPROJ'} = /$ENV{'PBPROJ'}/ftp 329 #sshport $ENV{'PBPROJ'} = 22 330 331 # 332 # For Virtual machines management 333 # Naming convention to follow: distribution name (as per ProjectBuilder::Distribution) 334 # followed by '-' and by release number 335 # followed by '-' and by architecture 336 # a .vmtype extension will be added to the resulting string 337 # a QEMU rhel-3-i286 here means that the VM will be named rhel-3-i386.qemu 338 # 339 #vmlist $ENV{'PBPROJ'} = mandrake-10.1-i386,mandrake-10.2-i386,mandriva-2006.0-i386,mandriva-2007.0-i386,mandriva-2007.1-i386,mandriva-2008.0-i386,redhat-7.3-i386,redhat-9-i386,fedora-4-i386,fedora-5-i386,fedora-6-i386,fedora-7-i386,fedora-8-i386,rhel-3-i386,rhel-4-i386,rhel-5-i386,suse-10.0-i386,suse-10.1-i386,suse-10.2-i386,suse-10.3-i386,sles-9-i386,sles-10-i386,gentoo-nover-i386,debian-3.1-i386,debian-4.0-i386,ubuntu-6.06-i386,ubuntu-7.04-i386,ubuntu-7.10-i386,mandriva-2007.0-x86_64,mandriva-2007.1-x86_64,mandriva-2008.0-x86_64,fedora-6-x86_64,fedora-7-x86_64,fedora-8-x86_64,rhel-4-x86_64,rhel-5-x86_64,suse-10.2-x86_64,suse-10.3-x86_64,sles-10-x86_64,gentoo-nover-x86_64,debian-4.0-x86_64,ubuntu-7.04-x86_64,ubuntu-7.10-x86_64 340 341 # 342 # Valid values for vmtype are 343 # qemu, (vmware, xen, ... TBD) 344 #vmtype $ENV{'PBPROJ'} = qemu 345 346 # Hash for VM stuff on vmtype 347 #vmntp default = pool.ntp.org 348 349 # We suppose we can commmunicate with the VM through SSH 350 #vmhost $ENV{'PBPROJ'} = localhost 351 #vmlogin $ENV{'PBPROJ'} = pb 352 #vmport $ENV{'PBPROJ'} = 2222 353 354 # Timeout to wait when VM is launched/stopped 355 #vmtmout default = 120 356 357 # per VMs needed paramaters 358 #vmopt $ENV{'PBPROJ'} = -m 384 -daemonize 359 #vmpath $ENV{'PBPROJ'} = /home/qemu 360 #vmsize $ENV{'PBPROJ'} = 5G 361 362 # 363 # For Virtual environment management 364 # Naming convention to follow: distribution name (as per ProjectBuilder::Distribution) 365 # followed by '-' and by release number 366 # followed by '-' and by architecture 367 # a .vetype extension will be added to the resulting string 368 # a chroot rhel-3-i286 here means that the VE will be named rhel-3-i386.chroot 369 # 370 #velist $ENV{'PBPROJ'} = fedora-7-i386 371 372 # VE params 373 #vetype $ENV{'PBPROJ'} = chroot 374 #ventp default = pool.ntp.org 375 #velogin $ENV{'PBPROJ'} = pb 376 #vepath $ENV{'PBPROJ'} = /var/lib/mock 377 #veconf $ENV{'PBPROJ'} = /etc/mock 378 #verebuild $ENV{'PBPROJ'} = false 379 380 # 381 # Global version/tag for the project 382 # 383 #projver $ENV{'PBPROJ'} = devel 384 #projtag $ENV{'PBPROJ'} = 1 385 386 # Hash of valid version names 387 #version $ENV{'PBPROJ'} = devel,stable 388 389 # Adapt to your needs: 390 # Optional if you need to overwrite the global values above 391 # 392 EOF 393 394 foreach my $pp (@pkgs) { 395 print CONF << "EOF"; 396 #pkgver $pp = stable 397 #pkgtag $pp = 3 398 EOF 399 } 400 foreach my $pp (@pkgs) { 401 print CONF << "EOF"; 402 # Hash of default package/package directory 403 #defpkgdir $pp = dir-$pp 404 EOF 405 } 406 407 print CONF << "EOF"; 408 # Hash of additional package/package directory 409 #extpkgdir minor-pkg = dir-minor-pkg 410 411 # List of files per pkg on which to apply filters 412 # Files are mentioned relatively to pbroot/defpkgdir 413 EOF 414 foreach my $pp (@pkgs) { 415 print CONF << "EOF"; 416 #filteredfiles $pp = Makefile.PL,configure.in,install.sh,$pp.8 417 #supfiles $pp = $pp.init 418 EOF 419 } 420 close(CONF); 421 pb_mkdir_p("$ENV{'PBROOTDIR'}/pbfilter") || die "Unable to create $ENV{'PBROOTDIR'}/pbfilter"; 422 open(CONF,"> $ENV{'PBROOTDIR'}/pbfilter/all.pbf") || die "Unable to create $ENV{'PBROOTDIR'}/pbfilter/all.pbf"; 423 print CONF << "EOF"; 424 # 425 # \$Id\$ 426 # 427 # Filter for all files 428 # 429 # PBSRC is replaced by the source package format 430 #filter PBSRC = ftp://ftp.$ENV{'PBPROJ'}.org/src/%{name}-%{version}.tar.gz 431 432 # PBVER is replaced by the version (\$pbver in code) 433 filter PBVER = \$pbver 434 435 # PBDATE is replaced by the date (\$pbdate in code) 436 filter PBDATE = \$pbdate 437 438 # PBLOG is replaced by the changelog if value is yes 439 #filter PBLOG = yes 440 441 # PBTAG is replaced by the tag (\$pbtag in code) 442 filter PBTAG = \$pbtag 443 444 # PBREV is replaced by the revision (\$pbrev in code) 445 filter PBREV = \$pbrev 446 447 # PBPKG is replaced by the package name (\$pbpkg in code) 448 filter PBPKG = \$pbpkg 449 450 # PBPACKAGER is replaced by the packager name (\$pbpackager in code) 451 filter PBPACKAGER = \$pbpackager 452 453 # PBDESC contains the description of the package 454 #filter PBDESC = "Bla-Bla" 455 456 # PBURL contains the URL of the Web site of the project 457 #filter PBURL = http://www.$ENV{'PBPROJ'}.org 458 EOF 459 close(CONF); 460 open(CONF,"> $ENV{'PBROOTDIR'}/pbfilter/rpm.pbf") || die "Unable to create $ENV{'PBROOTDIR'}/pbfilter/rpm.pbf"; 461 print CONF << "EOF"; 462 # 463 # \$Id\$ 464 # 465 # Filter for rpm build 466 # 467 468 # PBGRP is replaced by the RPM group of apps 469 # Cf: http://fedoraproject.org/wiki/RPMGroups 470 #filter PBGRP = Applications/Archiving 471 472 # PBLIC is replaced by the license of the application 473 # Cf: http://fedoraproject.org/wiki/Licensing 474 #filter PBLIC = GPL 475 476 # PBDEP is replaced by the list of dependencies 477 #filter PBDEP = 478 479 # PBSUF is replaced by the package suffix (\$pbsuf in code) 480 filter PBSUF = \$pbsuf 481 482 # PBOBS is replaced by the Obsolete line 483 #filter PBOBS = 484 485 EOF 486 close(CONF); 487 open(CONF,"> $ENV{'PBROOTDIR'}/pbfilter/deb.pbf") || die "Unable to create $ENV{'PBROOTDIR'}/pbfilter/deb.pbf"; 488 print CONF << "EOF"; 489 # 490 # \$Id\$ 491 # 492 # Filter for debian build 493 # 494 # PBGRP is replaced by the group of apps 495 filter PBGRP = utils 496 497 # PBLIC is replaced by the license of the application 498 # Cf: 499 #filter PBLIC = GPL 500 501 # PBDEP is replaced by the list of dependencies 502 #filter PBDEP = 503 504 # PBSUG is replaced by the list of suggestions 505 #filter PBSUG = 506 507 # PBREC is replaced by the list of recommandations 508 #filter PBREC = 509 510 EOF 511 close(CONF); 512 open(CONF,"> $ENV{'PBROOTDIR'}/pbfilter/md.pbf") || die "Unable to create $ENV{'PBROOTDIR'}/pbfilter/md.pbf"; 513 print CONF << "EOF"; 514 # Specific group for Mandriva for $ENV{'PBPROJ'} 515 # Cf: http://wiki.mandriva.com/en/Development/Packaging/Groups 516 #filter PBGRP = Archiving/Backup 517 518 # PBLIC is replaced by the license of the application 519 # Cf: http://wiki.mandriva.com/en/Development/Packaging/Licenses 520 #filter PBLIC = GPL 521 522 EOF 523 close(CONF); 524 open(CONF,"> $ENV{'PBROOTDIR'}/pbfilter/novell.pbf") || die "Unable to create $ENV{'PBROOTDIR'}/pbfilter/novell.pbf"; 525 print CONF << "EOF"; 526 # Specific group for SuSE for $ENV{'PBPROJ'} 527 # Cf: http://en.opensuse.org/SUSE_Package_Conventions/RPM_Groups 528 #filter PBGRP = Productivity/Archiving/Backup 529 530 # PBLIC is replaced by the license of the application 531 # Cf: http://en.opensuse.org/Packaging/SUSE_Package_Conventions/RPM_Style#1.6._License_Tag 532 #filter PBLIC = GPL 533 534 EOF 535 close(CONF); 536 foreach my $pp (@pkgs) { 537 pb_mkdir_p("$ENV{'PBROOTDIR'}/$pp/deb") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/deb"; 538 open(CONF,"> $ENV{'PBROOTDIR'}/$pp/deb/control") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/deb/control"; 539 print CONF << "EOF"; 540 Source: PBPKG 541 Section: PBGRP 542 Priority: optional 543 Maintainer: PBPACKAGER 544 Build-Depends: debhelper (>= 4.2.20), PBDEP 545 Standards-Version: 3.6.1 546 547 Package: PBPKG 548 Architecture: amd64 i386 ia64 549 Section: PBGRP 550 Priority: optional 551 Depends: \${shlibs:Depends}, \${misc:Depends}, PBDEP 552 Recommends: PBREC 553 Suggests: PBSUG 554 Description: 555 PBDESC 556 . 557 Homepage: PBURL 558 559 EOF 560 close(CONF); 561 open(CONF,"> $ENV{'PBROOTDIR'}/$pp/deb/copyright") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/deb/copyright"; 562 print CONF << "EOF"; 563 This package is debianized by PBPACKAGER 564 `date` 565 566 The current upstream source was downloaded from 567 ftp://ftp.$ENV{'PBPROJ'}.org/src/. 568 569 Upstream Authors: Put their name here 570 571 Copyright: 572 573 This package is free software; you can redistribute it and/or modify 574 it under the terms of the GNU General Public License as published by 575 the Free Software Foundation; version 2 dated June, 1991. 576 577 This package is distributed in the hope that it will be useful, 578 but WITHOUT ANY WARRANTY; without even the implied warranty of 579 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 580 GNU General Public License for more details. 581 582 You should have received a copy of the GNU General Public License 583 along with this package; if not, write to the Free Software 584 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, 585 MA 02110-1301, USA. 586 587 On Debian systems, the complete text of the GNU General 588 Public License can be found in /usr/share/common-licenses/GPL. 589 590 EOF 591 close(CONF); 592 open(CONF,"> $ENV{'PBROOTDIR'}/$pp/deb/changelog") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/deb/changelog"; 593 print CONF << "EOF"; 594 PBLOG 595 EOF 596 close(CONF); 597 open(CONF,"> $ENV{'PBROOTDIR'}/$pp/deb/compat") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/deb/compat"; 598 print CONF << "EOF"; 599 4 600 EOF 601 close(CONF); 602 open(CONF,"> $ENV{'PBROOTDIR'}/$pp/deb/$pp.dirs") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/deb/$pp.dirs"; 603 print CONF << "EOF"; 604 EOF 605 close(CONF); 606 open(CONF,"> $ENV{'PBROOTDIR'}/$pp/deb/$pp.docs") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/deb/$pp.docs"; 607 print CONF << "EOF"; 608 INSTALL 609 COPYING 610 AUTHORS 611 NEWS 612 README 613 EOF 614 close(CONF); 615 open(CONF,"> $ENV{'PBROOTDIR'}/$pp/deb/rules") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/deb/rules"; 616 print CONF << 'EOF'; 617 #!/usr/bin/make -f 618 # -*- makefile -*- 619 # Sample debian/rules that uses debhelper. 620 # GNU copyright 1997 to 1999 by Joey Hess. 621 # 622 # $Id$ 623 # 624 625 # Uncomment this to turn on verbose mode. 626 #export DH_VERBOSE=1 627 628 # Define package name variable for a one-stop change. 629 PACKAGE_NAME = PBPKG 630 631 # These are used for cross-compiling and for saving the configure script 632 # from having to guess our platform (since we know it already) 633 DEB_HOST_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_HOST_GNU_TYPE) 634 DEB_BUILD_GNU_TYPE ?= $(shell dpkg-architecture -qDEB_BUILD_GNU_TYPE) 635 636 CFLAGS = -Wall -g 637 638 ifneq (,$(findstring noopt,$(DEB_BUILD_OPTIONS))) 639 CFLAGS += -O0 640 else 641 CFLAGS += -O2 642 endif 643 ifeq (,$(findstring nostrip,$(DEB_BUILD_OPTIONS))) 644 INSTALL_PROGRAM += -s 645 endif 646 config.status: configure 647 dh_testdir 648 649 # Configure the package. 650 CFLAGS="$(CFLAGS)" ./configure --host=$(DEB_HOST_GNU_TYPE) --build=$(DEB_BUILD_GNU_TYPE) --prefix=/usr 651 --mandir=\$${prefix}/share/man 652 653 # Build both architecture dependent and independent 654 build: build-arch build-indep 655 656 # Build architecture dependent 657 build-arch: build-arch-stamp 658 659 build-arch-stamp: config.status 660 dh_testdir 661 662 # Compile the package. 663 $(MAKE) 664 665 touch build-stamp 666 667 # Build architecture independent 668 build-indep: build-indep-stamp 669 670 build-indep-stamp: config.status 671 # Nothing to do, the only indep item is the manual which is available as html in original source 672 touch build-indep-stamp 673 674 # Clean up 675 clean: 676 dh_testdir 677 dh_testroot 678 rm -f build-arch-stamp build-indep-stamp #CONFIGURE-STAMP# 679 # Clean temporary document directory 680 rm -rf debian/doc-temp 681 # Clean up. 682 -$(MAKE) distclean 683 rm -f config.log 684 ifneq "$(wildcard /usr/share/misc/config.sub)" "" 685 cp -f /usr/share/misc/config.sub config.sub 686 endif 687 ifneq "$(wildcard /usr/share/misc/config.guess)" "" 688 cp -f /usr/share/misc/config.guess config.guess 689 endif 690 691 dh_clean 692 693 # Install architecture dependent and independent 694 install: install-arch install-indep 695 696 # Install architecture dependent 697 install-arch: build-arch 698 dh_testdir 699 dh_testroot 700 dh_clean -k -s 701 dh_installdirs -s 702 703 # Install the package files into build directory: 704 # - start with upstream make install 705 $(MAKE) install prefix=$(CURDIR)/debian/$(PACKAGE_NAME)/usr mandir=$(CURDIR)/debian/$(PACKAGE_NAME)/us 706 r/share/man 707 # - copy html manual to temporary location for renaming 708 mkdir -p debian/doc-temp 709 dh_install -s 710 711 # Install architecture independent 712 install-indep: build-indep 713 dh_testdir 714 dh_testroot 715 dh_clean -k -i 716 dh_installdirs -i 717 dh_install -i 718 719 # Must not depend on anything. This is to be called by 720 # binary-arch/binary-indep 721 # in another 'make' thread. 722 binary-common: 723 dh_testdir 724 dh_testroot 725 dh_installchangelogs ChangeLog 726 dh_installdocs 727 dh_installman 728 dh_link 729 dh_strip 730 dh_compress 731 dh_fixperms 732 dh_installdeb 733 dh_shlibdeps 734 dh_gencontrol 735 dh_md5sums 736 dh_builddeb 737 738 # Build architecture independant packages using the common target. 739 binary-indep: build-indep install-indep 740 $(MAKE) -f debian/rules DH_OPTIONS=-i binary-common 741 742 # Build architecture dependant packages using the common target. 743 binary-arch: build-arch install-arch 744 $(MAKE) -f debian/rules DH_OPTIONS=-a binary-common 745 746 # Build architecture depdendent and independent packages 747 binary: binary-arch binary-indep 748 .PHONY: clean binary 749 750 EOF 751 close(CONF); 752 pb_mkdir_p("$ENV{'PBROOTDIR'}/$pp/rpm") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/rpm"; 753 open(CONF,"> $ENV{'PBROOTDIR'}/$pp/rpm/$pp.spec") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/rpm/$pp.spec"; 754 print CONF << 'EOF'; 755 # 756 # $Id$ 757 # 758 759 Summary: bla-bla 760 Summary(fr): french bla-bla 761 762 Name: PBPKG 763 Version: PBVER 764 Release: PBTAGPBSUF 765 License: PBLIC 766 Group: PBGRP 767 Url: PBURL 768 Source: PBSRC 769 BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(id -u -n) 770 #Requires: PBDEP 771 772 %description 773 PBDESC 774 775 %description -l fr 776 french desc 777 778 %prep 779 %setup -q 780 781 %build 782 %configure 783 make %{?_smp_mflags} 784 785 %install 786 %{__rm} -rf $RPM_BUILD_ROOT 787 make DESTDIR=$RPM_BUILD_ROOT install 788 789 %clean 790 %{__rm} -rf $RPM_BUILD_ROOT 791 792 %files 793 %defattr(-,root,root) 794 %doc ChangeLog 795 %doc INSTALL COPYING README AUTHORS NEWS 796 797 %changelog 798 PBLOG 799 800 EOF 801 close(CONF); 802 pb_mkdir_p("$ENV{'PBROOTDIR'}/$pp/pbfilter") || die "Unable to create $ENV{'PBROOTDIR'}/$pp/pbfilter"; 803 804 pb_log(0,"\nDo not to forget to commit the pbconf directory in your CMS if needed\n"); 805 } 806 } else { 807 die "Unable to open $ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb"; 808 } 809 } 810 umask 0022; 811 return(\%filteredfiles, \%supfiles, \%defpkgdir, \%extpkgdir); 812 } else { 813 # Setup the variables from what has been stored at the end of cms2build 814 my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/pbrc","pbroot"); 815 $ENV{'PBROOTDIR'} = $var->{$ENV{'PBPROJ'}}; 816 817 ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/pbrc","projver"); 818 $ENV{'PBPROJVER'} = $var->{$ENV{'PBPROJ'}}; 819 820 ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/pbrc","projtag"); 821 $ENV{'PBPROJTAG'} = $var->{$ENV{'PBPROJ'}}; 822 823 ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/pbrc","pbpackager"); 824 $ENV{'PBPACKAGER'} = $var->{$ENV{'PBPROJ'}}; 825 826 return; 827 } 828 } 829 830 # Internal mkdir -p function 33 our @EXPORT = qw(pb_conf_read pb_conf_read_if pb_mkdir_p pb_system pb_rm_rf pb_get_date pb_log pb_log_init pb_get_uri pb_get_content pb_display_file $debug $LOG); 34 35 =pod 36 37 =head1 NAME 38 39 ProjectBuilder::Base, part of the project-builder.org - module dealing with generic functions suitable for perl project development 40 41 =head1 DESCRIPTION 42 43 This modules provides generic functions suitable for perl project development 44 45 =head1 SYNOPSIS 46 47 use ProjectBuilder::Base; 48 49 # 50 # Create a directory and its parents 51 # 52 pb_mkdir_p("/tmp/foo/bar"); 53 54 # 55 # Remove recursively a directory and its children 56 # 57 pb_rm_rf("/tmp/foo"); 58 59 # 60 # Encapsulate the system call for better output and return value test 61 # 62 pb_system("ls -l", "Printing directory content"); 63 64 # 65 # Read hash codes of values from a configuration file and return table of pointers 66 # 67 my ($k1, $k2) = pb_conf_read_if("$ENV{'HOME'}/.pbrc","key1","key2"); 68 my ($k) = pb_conf_read("$ENV{'HOME'}/.pbrc","key"); 69 70 # 71 # Analysis a URI and return its components in a table 72 # 73 my ($scheme, $account, $host, $port, $path) = pb_get_uri("svn+ssh://ac@my.server.org/path/to/dir"); 74 75 # 76 # Gives the current date in a table 77 # 78 @date = pb_get_date(); 79 80 # 81 # Manages logs of the program 82 # 83 pb_log_init(2,\*STDOUT); 84 pb_log(1,"Message to print\n"); 85 86 # 87 # Manages content of a file 88 # 89 pb_display_file("/etc/passwd"); 90 my $cnt = pb_get_content("/etc/passwd"); 91 92 =head1 USAGE 93 94 =over 4 95 96 =item B<pb_mkdir_p> 97 98 Internal mkdir -p function. Forces mode to 755. Supports multiple parameters. 99 Based in File::Path mkpath. 100 101 =cut 102 831 103 sub pb_mkdir_p { 832 104 my @dir = @_; … … 835 107 } 836 108 837 # Internal rm -rf function 109 =item B<pb_mkdir_p> 110 111 Internal rm -rf function. Supports multiple parameters. 112 Based in File::Path rmtree. 113 114 =cut 115 838 116 sub pb_rm_rf { 839 117 my @dir = @_; … … 842 120 } 843 121 844 # Internal system function 122 =item B<pb_system> 123 124 Encapsulate the "system" call for better output and return value test 125 Needs a $ENV{'PBTMP'} variable which is created by calling the pb_mktemp_init function 126 Needs pb_log support, so pb_log_init should have benn called before. 127 128 The first parameter is the shell command to call. 129 The second parameter is the message to print on screen. If none is given, then the command is printed. 130 This function returns the result the return value of the system command. 131 If no error reported, it prints OK on the screen, just after the message. Else it prints the errors generated. 132 133 =cut 134 845 135 sub pb_system { 846 136 … … 849 139 850 140 pb_log(0,"$cmt... "); 851 #system("$cmd 2>&1 > $ENV{'PBTMP'}/system.log");141 pb_log(1,"Executing $cmd\n"); 852 142 system($cmd); 853 pb_log(1,"Executing $cmd\n");854 143 my $res = $?; 855 144 if ($res == -1) { … … 868 157 } 869 158 870 sub pb_display_file { 871 872 my $file=shift; 873 874 return if (not -f $file); 875 open(FILE,"$file"); 876 while (<FILE>) { 877 print $_; 878 } 879 close(FILE); 880 } 881 882 # Function which returns a pointer on a table 883 # corresponding to a set of values queried in the conf file 884 # and test the returned vaue as they need to exist in that case 885 sub pb_conf_get { 886 887 my @param = @_; 888 my @return = pb_conf_get_if(@param); 889 890 die "No params found for $ENV{'PBPROJ'}" if (not @return); 891 892 foreach my $i (0..$#param) { 893 die "No $param[$i] defined for $ENV{'PBPROJ'}" if (not defined $return[$i]); 894 } 895 return(@return); 896 } 897 898 # Function which returns a pointer on a table 899 # corresponding to a set of values queried in the conf file 900 # Those value may be undef if they do not exist 901 sub pb_conf_get_if { 902 903 my @param = @_; 904 905 # Everything is returned via ptr1 906 my @ptr1 = (); 907 my @ptr2 = (); 908 @ptr1 = pb_conf_read_if("$ENV{'PBETC'}", @param) if (defined $ENV{'PBETC'}); 909 @ptr2 = pb_conf_read_if("$ENV{'PBROOTDIR'}/$ENV{'PBPROJ'}.pb", @param) if ((defined $ENV{'PBROOTDIR'}) and (defined $ENV{'PBPROJ'})); 910 911 my $p1; 912 my $p2; 913 914 pb_log(2,"DEBUG: pb_conf_get param1: ".Dumper(@ptr1)."\n"); 915 pb_log(2,"DEBUG: pb_conf_get param2: ".Dumper(@ptr2)."\n"); 916 917 foreach my $i (0..$#param) { 918 $p1 = $ptr1[$i]; 919 $p2 = $ptr2[$i]; 920 # Always try to take the param from the home dir conf file in priority 921 # in order to mask what could be defined under the CMS to allow for overloading 922 if (not defined $p2) { 923 # No ref in CMS project conf file so use the home dir one. 924 $p1->{$ENV{'PBPROJ'}} = $p1->{'default'} if ((not defined $p1->{$ENV{'PBPROJ'}}) && (defined $p1->{'default'})); 925 } else { 926 # Ref found in CMS project conf file 927 if (not defined $p1) { 928 # No ref in home dir project conf file so use the CMS one. 929 $p2->{$ENV{'PBPROJ'}} = $p2->{'default'} if ((not defined $p2->{$ENV{'PBPROJ'}}) && (defined $p2->{'default'})); 930 $p1 = $p2; 931 } else { 932 # Both are defined - handling the overloading 933 if (not defined $p1->{'default'}) { 934 if (defined $p2->{'default'}) { 935 $p1->{'default'} = $p2->{'default'}; 936 } 937 } 938 939 if (not defined $p1->{$ENV{'PBPROJ'}}) { 940 if (defined $p2->{$ENV{'PBPROJ'}}) { 941 $p1->{$ENV{'PBPROJ'}} = $p2->{$ENV{'PBPROJ'}} if (defined $p2->{$ENV{'PBPROJ'}}); 942 } else { 943 $p1->{$ENV{'PBPROJ'}} = $p1->{'default'} if (defined $p1->{'default'}); 944 } 945 } 946 # Now copy back into p1 all p2 content which doesn't exist in p1 947 # p1 content (local) always has priority over p2 (project) 948 foreach my $k (keys %$p2) { 949 $p1->{$k} = $p2->{$k} if (not defined $p1->{$k}); 950 } 951 } 952 } 953 $ptr1[$i] = $p1; 954 } 955 pb_log(2,"DEBUG: pb_conf_get param ptr1: ".Dumper(@ptr1)."\n"); 956 return(@ptr1); 957 } 958 959 # Function which returns a pointer on a hash 960 # corresponding to a declaration (arg2) in a conf file (arg1) 961 # if that conf file doesn't exist returns undef 159 =item B<pb_conf_read_if> 160 161 This function returns a table of pointers on hashes 162 corresponding to the keys in a configuration file passed in parameter. 163 If that file doesn't exist, it returns undef. 164 165 The format of the configuration file is as follows: 166 167 key tag = value1,value2,... 168 169 Supposing the file is called "$ENV{'HOME'}/.pbrc", containing the following: 170 171 $ cat $HOME/.pbrc 172 pbver pb = 3 173 pbver default = 1 174 pblist pb = 12,25 175 176 calling it like this: 177 178 my ($k1, $k2) = pb_conf_read_if("$ENV{'HOME'}/.pbrc","pbver","pblist"); 179 180 will allow to get the mapping 181 $k1->{'pb'} contains 3 182 $ka->{'default'} contains 1 183 $k2->{'pb'} contains 12,25 184 185 Valid chars for keys and tags are letters, numbers, '-' and '_'. 186 187 =cut 188 962 189 sub pb_conf_read_if { 963 190 … … 970 197 } 971 198 972 # Function which returns a pointer on a hash 973 # corresponding to a declaration (arg2) in a conf file (arg1) 199 =item B<pb_conf_read> 200 201 This function is similar to B<pb_conf_read_if> except that it dies when the file in parameter doesn't exist. 202 203 =cut 204 974 205 sub pb_conf_read { 975 206 … … 995 226 } 996 227 997 # Analyze a url passed and return protocol, account, password, server, port, path 228 =item B<pb_get_uri> 229 230 This function returns a list of 6 parameters indicating the protocol, account, password, server, port, and path contained in the URI passed in parameter. 231 232 A URI has the format protocol://[ac@]host[:port][path[?query][#fragment]]. 233 Cf man URI. 234 235 =cut 236 998 237 sub pb_get_uri { 999 238 … … 1001 240 1002 241 pb_log(2,"DEBUG: uri:$uri\n"); 1003 # A URL has the format protocol://[ac@]host[:port][path[?query][#fragment]].1004 # Cf man URI1005 242 my ($scheme, $authority, $path, $query, $fragment) = 1006 243 $uri =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?| if (defined $uri); … … 1018 255 } 1019 256 1020 1021 # Setup environment for CMS system for URL passed 1022 sub pb_cms_init { 1023 1024 my $pbinit = shift || undef; 1025 1026 my ($pburl) = pb_conf_get("pburl"); 1027 pb_log(2,"DEBUG: Project URL of $ENV{'PBPROJ'}: $pburl->{$ENV{'PBPROJ'}}\n"); 1028 my ($scheme, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}}); 1029 1030 my ($pbprojdir) = pb_conf_get_if("pbprojdir"); 1031 1032 if ((defined $pbprojdir) && (defined $pbprojdir->{$ENV{'PBPROJ'}})) { 1033 $ENV{'PBPROJDIR'} = $pbprojdir->{$ENV{'PBPROJ'}}; 1034 } else { 1035 $ENV{'PBPROJDIR'} = "$ENV{'PBDEFDIR'}/$ENV{'PBPROJ'}"; 1036 } 1037 1038 # Computing the default dir for PBDIR. 1039 # what we have is PBPROJDIR so work from that. 1040 # Tree identical between PBCONFDIR and PBROOTDIR on one side and 1041 # PBPROJDIR and PBDIR on the other side. 1042 1043 my $tmp = $ENV{'PBROOTDIR'}; 1044 $tmp =~ s|^$ENV{'PBCONFDIR'}||; 1045 1046 # 1047 # Check project cms compliance 1048 # 1049 pb_cms_compliant(undef,'PBDIR',"$ENV{'PBPROJDIR'}/$tmp",$pburl->{$ENV{'PBPROJ'}},$pbinit); 1050 1051 if ($scheme =~ /^svn/) { 1052 # svnversion more precise than svn info 1053 $tmp = `(cd "$ENV{'PBDIR'}" ; svnversion .)`; 1054 chomp($tmp); 1055 $ENV{'PBREVISION'}=$tmp; 1056 $ENV{'PBCMSLOGFILE'}="svn.log"; 1057 } elsif (($scheme eq "file") || ($scheme eq "ftp") || ($scheme eq "http")) { 1058 $ENV{'PBREVISION'}="flat"; 1059 $ENV{'PBCMSLOGFILE'}="flat.log"; 1060 } elsif ($scheme =~ /^cvs/) { 1061 # Way too slow 1062 #$ENV{'PBREVISION'}=`(cd "$ENV{'PBROOTDIR'}" ; cvs rannotate -f . 2>&1 | awk '{print \$1}' | grep -E '^[0-9]' | cut -d. -f2 |sort -nu | tail -1)`; 1063 #chomp($ENV{'PBREVISION'}); 1064 $ENV{'PBREVISION'}="cvs"; 1065 $ENV{'PBCMSLOGFILE'}="cvs.log"; 1066 $ENV{'CVS_RSH'} = "ssh" if ($scheme =~ /ssh/); 1067 } else { 1068 die "cms $scheme unknown"; 1069 } 1070 1071 return($scheme,$pburl->{$ENV{'PBPROJ'}}); 1072 } 257 =item B<pb_get_date> 258 259 This function returns a list of 9 parameters indicating the seconds, minutes, hours, day, month, year, day in the week, day in the year, and daylight saving time flag of the current time. 260 261 Cf: man ctime and description of the struct tm. 262 263 =cut 1073 264 1074 265 sub pb_get_date { … … 1077 268 } 1078 269 1079 sub pb_cms_export { 1080 1081 my $uri = shift; 1082 my $source = shift; 1083 my $destdir = shift; 1084 my $tmp; 1085 my $tmp1; 1086 1087 my @date = pb_get_date(); 1088 # If it's not flat, then we have a real uri as source 1089 my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri); 1090 1091 if ($scheme =~ /^svn/) { 1092 if (-d $source) { 1093 $tmp = $destdir; 1094 } else { 1095 $tmp = "$destdir/".basename($source); 1096 } 1097 pb_system("svn export $source $tmp","Exporting $source from SVN to $tmp"); 1098 } elsif ($scheme eq "dir") { 1099 pb_system("cp -a $path $destdir","Copying $uri from DIR to $destdir"); 1100 } elsif (($scheme eq "http") || ($scheme eq "ftp")) { 1101 my $f = basename($path); 1102 unlink "$ENV{'PBTMP'}/$f"; 1103 if (-x "/usr/bin/wget") { 1104 pb_system("/usr/bin/wget -nv -O $ENV{'PBTMP'}/$f $uri"," "); 1105 } elsif (-x "/usr/bin/curl") { 1106 pb_system("/usr/bin/curl $uri -o $ENV{'PBTMP'}/$f","Downloading $uri with curl to $ENV{'PBTMP'}/$f\n"); 1107 } else { 1108 die "Unable to download $uri.\nNo wget/curl available, please install one of those"; 1109 } 1110 pb_cms_export("file://$ENV{'PBTMP'}/$f",$source,$destdir); 1111 } elsif ($scheme eq "file") { 1112 use File::MimeInfo; 1113 my $mm = mimetype($path); 1114 pb_log(2,"mimetype: $mm\n"); 1115 pb_mkdir_p($destdir); 1116 1117 # Check whether the file is well formed 1118 # (containing already a directory with the project-version name) 1119 my ($pbwf) = pb_conf_get_if("pbwf"); 1120 if ((defined $pbwf) && (defined $pbwf->{$ENV{'PBPROJ'}})) { 1121 $destdir = dirname($destdir); 1122 } 1123 1124 if ($mm =~ /\/x-bzip-compressed-tar$/) { 1125 # tar+bzip2 1126 pb_system("cd $destdir ; tar xfj $path","Extracting $path in $destdir"); 1127 } elsif ($mm =~ /\/x-lzma-compressed-tar$/) { 1128 # tar+lzma 1129 pb_system("cd $destdir ; tar xfY $path","Extracting $path in $destdir"); 1130 } elsif ($mm =~ /\/x-compressed-tar$/) { 1131 # tar+gzip 1132 pb_system("cd $destdir ; tar xfz $path","Extracting $path in $destdir"); 1133 } elsif ($mm =~ /\/x-tar$/) { 1134 # tar 1135 pb_system("cd $destdir ; tar xf $path","Extracting $path in $destdir"); 1136 } elsif ($mm =~ /\/zip$/) { 1137 # zip 1138 pb_system("cd $destdir ; unzip $path","Extracting $path in $destdir"); 1139 } 1140 } elsif ($scheme =~ /^cvs/) { 1141 # CVS needs a relative path ! 1142 my $dir=dirname($destdir); 1143 my $base=basename($destdir); 1144 # CVS also needs a modules name not a dir 1145 #if (-d $source) { 1146 $tmp1 = basename($source); 1147 #} else { 1148 #$tmp1 = dirname($source); 1149 #$tmp1 = basename($tmp1); 1150 #} 1151 my $optcvs = ""; 1152 1153 # If we're working on the CVS itself 1154 my $cvstag = basename($ENV{'PBROOTDIR'}); 1155 my $cvsopt = ""; 1156 if ($cvstag eq "cvs") { 1157 my $pbdate = strftime("%Y-%m-%d %H:%M:%S", @date); 1158 $cvsopt = "-D \"$pbdate\""; 1159 } else { 1160 # we're working on a tag which should be the last part of PBROOTDIR 1161 $cvsopt = "-r $cvstag"; 1162 } 1163 pb_system("cd $dir ; cvs -d $account\@$host:$path export $cvsopt -d $base $tmp1","Exporting $tmp1 from $source under CVS to $destdir"); 1164 } else { 1165 die "cms $scheme unknown"; 1166 } 1167 } 1168 1169 1170 sub pb_create_authors { 1171 1172 my $authors=shift; 1173 my $dest=shift; 1174 my $scheme=shift; 1175 1176 return if ($authors eq "/dev/null"); 1177 open(SAUTH,$authors) || die "Unable to open $authors"; 1178 # Save a potentially existing AUTHORS file and write instead toi AUTHORS.pb 1179 my $ext = ""; 1180 if (-f "$dest/AUTHORS") { 1181 $ext = ".pb"; 1182 } 1183 open(DAUTH,"> $dest/AUTHORS$ext") || die "Unable to create $dest/AUTHORS$ext"; 1184 print DAUTH "Authors of the project are:\n"; 1185 print DAUTH "===========================\n"; 1186 while (<SAUTH>) { 1187 my ($nick,$gcos) = split(/:/); 1188 chomp($gcos); 1189 print DAUTH "$gcos"; 1190 if (defined $scheme) { 1191 # Do not give a scheme for flat types 1192 my $endstr=""; 1193 if ("$ENV{'PBREVISION'}" ne "flat") { 1194 $endstr = " under $scheme"; 1195 } 1196 print DAUTH " ($nick$endstr)\n"; 1197 } else { 1198 print DAUTH "\n"; 1199 } 1200 } 1201 close(DAUTH); 1202 close(SAUTH); 1203 } 1204 1205 sub pb_cms_log { 1206 1207 my $scheme = shift; 1208 my $pkgdir = shift; 1209 my $dest = shift; 1210 my $chglog = shift; 1211 my $authors = shift; 1212 1213 pb_create_authors($authors,$dest,$scheme); 1214 1215 if ($scheme =~ /^svn/) { 1216 if (! -f "$dest/ChangeLog") { 1217 if (-x "/usr/bin/svn2cl") { 1218 # In case we have no network, just create an empty one before to allow correct build 1219 open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog"; 1220 close(CL); 1221 pb_system("/usr/bin/svn2cl --group-by-day --authors=$authors -i -o $dest/ChangeLog $pkgdir","Generating ChangeLog from SVN with svn2cl"); 1222 } else { 1223 # To be written from pbcl 1224 pb_system("svn log -v $pkgdir > $dest/$ENV{'PBCMSLOGFILE'}","Extracting log info from SVN"); 1225 } 1226 } 1227 } elsif (($scheme eq "file") || ($scheme eq "dir") || ($scheme eq "http") || ($scheme eq "ftp")) { 1228 if (! -f "$dest/ChangeLog") { 1229 pb_system("echo ChangeLog for $pkgdir > $dest/ChangeLog","Empty ChangeLog file created"); 1230 } 1231 } elsif ($scheme =~ /^cvs/) { 1232 my $tmp=basename($pkgdir); 1233 # CVS needs a relative path ! 1234 if (! -f "$dest/ChangeLog") { 1235 if (-x "/usr/bin/cvs2cl") { 1236 # In case we have no network, just create an empty one before to allow correct build 1237 open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog"; 1238 close(CL); 1239 pb_system("/usr/bin/cvs2cl --group-by-day -U $authors -f $dest/ChangeLog $pkgdir","Generating ChangeLog from CVS with cvs2cl"); 1240 } else { 1241 # To be written from pbcl 1242 pb_system("cvs log $tmp > $dest/$ENV{'PBCMSLOGFILE'}","Extracting log info from CVS"); 1243 } 1244 } 1245 } else { 1246 die "cms $scheme unknown"; 1247 } 1248 } 1249 1250 # This function is only called with a real CMS system 1251 sub pb_cms_get_uri { 1252 1253 my $scheme = shift; 1254 my $dir = shift; 1255 1256 my $res = ""; 1257 my $void = ""; 1258 1259 if ($scheme =~ /^svn/) { 1260 open(PIPE,"LANGUAGE=C svn info $dir |") || return(""); 1261 while (<PIPE>) { 1262 ($void,$res) = split(/^URL:/) if (/^URL:/); 1263 } 1264 $res =~ s/^\s*//; 1265 close(PIPE); 1266 chomp($res); 1267 } elsif ($scheme =~ /^cvs/) { 1268 # This path is always the root path of CVS, but we may be below 1269 open(FILE,"$dir/CVS/Root") || die "$dir isn't CVS controlled"; 1270 $res = <FILE>; 1271 chomp($res); 1272 close(FILE); 1273 # Find where we are in the tree 1274 my $rdir = $dir; 1275 while ((! -d "$rdir/CVSROOT") && ($rdir ne "/")) { 1276 $rdir = dirname($rdir); 1277 } 1278 die "Unable to find a CVSROOT dir in the parents of $dir" if (! -d "$rdir/CVSROOT"); 1279 #compute our place under that root dir - should be a relative path 1280 $dir =~ s|^$rdir||; 1281 my $suffix = ""; 1282 $suffix = "$dir" if ($dir ne ""); 1283 1284 my $prefix = ""; 1285 if ($scheme =~ /ssh/) { 1286 $prefix = "cvs+ssh://"; 1287 } else { 1288 $prefix = "cvs://"; 1289 } 1290 $res = $prefix.$res.$suffix; 1291 } else { 1292 die "cms $scheme unknown"; 1293 } 1294 pb_log(2,"Found CMS info: $res\n"); 1295 return($res); 1296 } 1297 1298 sub pb_cms_copy { 1299 my $scheme = shift; 1300 my $oldurl = shift; 1301 my $newurl = shift; 1302 1303 if ($scheme =~ /^svn/) { 1304 pb_system("svn copy -m \"Creation of $newurl from $oldurl\" $oldurl $newurl","Copying $oldurl to $newurl "); 1305 } elsif ($scheme eq "flat") { 1306 } elsif ($scheme =~ /^cvs/) { 1307 } else { 1308 die "cms $scheme unknown"; 1309 } 1310 } 1311 1312 sub pb_cms_checkout { 1313 my $scheme = shift; 1314 my $url = shift; 1315 my $destination = shift; 1316 1317 if ($scheme =~ /^svn/) { 1318 pb_system("svn co $url $destination","Checking out $url to $destination "); 1319 } elsif (($scheme eq "ftp") || ($scheme eq "http")) { 1320 return; 1321 } elsif ($scheme =~ /^cvs/) { 1322 pb_system("cvs co $url $destination","Checking out $url to $destination "); 1323 } else { 1324 die "cms $scheme unknown"; 1325 } 1326 } 1327 1328 sub pb_cms_up { 1329 my $scheme = shift; 1330 my $dir = shift; 1331 1332 if ($scheme =~ /^svn/) { 1333 pb_system("svn up $dir","Updating $dir"); 1334 } elsif ($scheme eq "flat") { 1335 } elsif ($scheme =~ /^cvs/) { 1336 } else { 1337 die "cms $scheme unknown"; 1338 } 1339 } 1340 1341 sub pb_cms_checkin { 1342 my $scheme = shift; 1343 my $dir = shift; 1344 1345 my $ver = basename($dir); 1346 if ($scheme =~ /^svn/) { 1347 pb_system("svn ci -m \"updated to $ver\" $dir","Checking in $dir"); 1348 } elsif ($scheme eq "flat") { 1349 } elsif ($scheme =~ /^cvs/) { 1350 } else { 1351 die "cms $scheme unknown"; 1352 } 1353 pb_cms_up($scheme,$dir); 1354 } 1355 1356 sub pb_cms_isdiff { 1357 my $scheme = shift; 1358 my $dir =shift; 1359 1360 if ($scheme =~ /^svn/) { 1361 open(PIPE,"svn diff $dir |") || die "Unable to get svn diff from $dir"; 1362 my $l = 0; 1363 while (<PIPE>) { 1364 $l++; 1365 } 1366 return($l); 1367 } elsif ($scheme eq "flat") { 1368 } elsif ($scheme =~ /^cvs/) { 1369 open(PIPE,"cvs diff $dir |") || die "Unable to get svn diff from $dir"; 1370 my $l = 0; 1371 while (<PIPE>) { 1372 # Skipping normal messages 1373 next if (/^cvs diff:/); 1374 $l++; 1375 } 1376 return($l); 1377 } else { 1378 die "cms $scheme unknown"; 1379 } 1380 } 1381 1382 # Get all filters to apply 1383 # They're cumulative from less specific to most specific 1384 # suffix is .pbf 1385 1386 sub pb_get_filters { 1387 1388 my @ffiles; 1389 my ($ffile00, $ffile0, $ffile1, $ffile2, $ffile3); 1390 my ($mfile00, $mfile0, $mfile1, $mfile2, $mfile3); 1391 my $pbpkg = shift || die "No package specified"; 1392 my $dtype = shift || ""; 1393 my $dfam = shift || ""; 1394 my $ddir = shift || ""; 1395 my $dver = shift || ""; 1396 my $ptr = undef; # returned value pointer on the hash of filters 1397 my %h; 1398 1399 # Global filter files first, then package specificities 1400 if (-d "$ENV{'PBROOTDIR'}/pbfilter") { 1401 $mfile00 = "$ENV{'PBROOTDIR'}/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/all.pbf"); 1402 $mfile0 = "$ENV{'PBROOTDIR'}/pbfilter/$dtype.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$dtype.pbf"); 1403 $mfile1 = "$ENV{'PBROOTDIR'}/pbfilter/$dfam.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$dfam.pbf"); 1404 $mfile2 = "$ENV{'PBROOTDIR'}/pbfilter/$ddir.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$ddir.pbf"); 1405 $mfile3 = "$ENV{'PBROOTDIR'}/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBROOTDIR'}/pbfilter/$ddir-$dver.pbf"); 1406 1407 push @ffiles,$mfile00 if (defined $mfile00); 1408 push @ffiles,$mfile0 if (defined $mfile0); 1409 push @ffiles,$mfile1 if (defined $mfile1); 1410 push @ffiles,$mfile2 if (defined $mfile2); 1411 push @ffiles,$mfile3 if (defined $mfile3); 1412 } 1413 1414 if (-d "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter") { 1415 $ffile00 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/all.pbf"); 1416 $ffile0 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dtype.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dtype.pbf"); 1417 $ffile1 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dfam.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$dfam.pbf"); 1418 $ffile2 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir.pbf"); 1419 $ffile3 = "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir-$dver.pbf" if (-f "$ENV{'PBROOTDIR'}/$pbpkg/pbfilter/$ddir-$dver.pbf"); 1420 1421 push @ffiles,$ffile00 if (defined $ffile00); 1422 push @ffiles,$ffile0 if (defined $ffile0); 1423 push @ffiles,$ffile1 if (defined $ffile1); 1424 push @ffiles,$ffile2 if (defined $ffile2); 1425 push @ffiles,$ffile3 if (defined $ffile3); 1426 } 1427 if (@ffiles) { 1428 pb_log(2,"DEBUG ffiles: ".Dumper(\@ffiles)."\n"); 1429 1430 foreach my $f (@ffiles) { 1431 open(CONF,$f) || next; 1432 while(<CONF>) { 1433 if (/^\s*([A-z0-9-_]+)\s+([[A-z0-9-_]+)\s*=\s*(.+)$/) { 1434 $h{$1}{$2}=$3; 1435 } 1436 } 1437 close(CONF); 1438 1439 $ptr = $h{"filter"}; 1440 pb_log(2,"DEBUG f:".Dumper($ptr)."\n"); 1441 } 1442 } 1443 return($ptr); 1444 } 1445 1446 # Function which applies filter on pb build files 1447 sub pb_filter_file_pb { 1448 1449 my $f=shift; 1450 my $ptr=shift; 1451 my %filter=%$ptr; 1452 my $destfile=shift; 1453 my $dtype=shift; 1454 my $pbsuf=shift; 1455 my $pbproj=shift; 1456 my $pbpkg=shift; 1457 my $pbver=shift; 1458 my $pbtag=shift; 1459 my $pbrev=shift; 1460 my $pbdate=shift; 1461 my $defpkgdir = shift; 1462 my $extpkgdir = shift; 1463 my $pbpackager = shift; 1464 my $chglog = shift || undef; 1465 1466 pb_log(2,"DEBUG: From $f to $destfile\n"); 1467 pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile)); 1468 open(DEST,"> $destfile") || die "Unable to create $destfile"; 1469 open(FILE,"$f") || die "Unable to open $f: $!"; 1470 while (<FILE>) { 1471 my $line = $_; 1472 foreach my $s (keys %filter) { 1473 # Process single variables 1474 pb_log(2,"DEBUG filter{$s}: $filter{$s}\n"); 1475 my $tmp = $filter{$s}; 1476 next if (not defined $tmp); 1477 # Expand variables if any single one found 1478 pb_log(2,"DEBUG tmp: $tmp\n"); 1479 if ($tmp =~ /\$/) { 1480 eval { $tmp =~ s/(\$\w+)/$1/eeg }; 1481 # special case for ChangeLog only for pb 1482 } elsif (($s =~ /^PBLOG$/) && ($line =~ /^PBLOG$/)) { 1483 my $p = $defpkgdir->{$pbpkg}; 1484 $p = $extpkgdir->{$pbpkg} if (not defined $p); 1485 pb_changelog($dtype, $pbpkg, $pbver, $pbtag, $pbsuf, $p, \*DEST, $tmp, $chglog); 1486 $tmp = ""; 1487 } 1488 $line =~ s|$s|$tmp|; 1489 } 1490 print DEST $line; 1491 } 1492 close(FILE); 1493 close(DEST); 1494 } 1495 1496 # Function which applies filter on files (external call) 1497 sub pb_filter_file_inplace { 1498 1499 my $ptr=shift; 1500 my %filter=%$ptr; 1501 my $destfile=shift; 1502 my $pbproj=shift; 1503 my $pbpkg=shift; 1504 my $pbver=shift; 1505 my $pbtag=shift; 1506 my $pbrev=shift; 1507 my $pbdate=shift; 1508 my $pbpackager=shift; 1509 1510 my $cp = "$ENV{'PBTMP'}/".basename($destfile); 1511 copy($destfile,$cp) || die "Unable to create $cp"; 1512 1513 pb_filter_file($cp,$ptr,$destfile,$pbproj,$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$pbpackager); 1514 unlink $cp; 1515 } 1516 1517 # Function which applies filter on files (external call) 1518 sub pb_filter_file { 1519 1520 my $f=shift; 1521 my $ptr=shift; 1522 my %filter=%$ptr; 1523 my $destfile=shift; 1524 my $pbproj=shift; 1525 my $pbpkg=shift; 1526 my $pbver=shift; 1527 my $pbtag=shift; 1528 my $pbrev=shift; 1529 my $pbdate=shift; 1530 my $pbpackager=shift; 1531 1532 pb_log(2,"DEBUG: From $f to $destfile\n"); 1533 pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile)); 1534 open(DEST,"> $destfile") || die "Unable to create $destfile"; 1535 open(FILE,"$f") || die "Unable to open $f: $!"; 1536 while (<FILE>) { 1537 my $line = $_; 1538 foreach my $s (keys %filter) { 1539 # Process single variables 1540 pb_log(2,"DEBUG filter{$s}: $filter{$s}\n"); 1541 my $tmp = $filter{$s}; 1542 next if (not defined $tmp); 1543 # Expand variables if any single one found 1544 if ($tmp =~ /\$/) { 1545 eval { $tmp =~ s/(\$\w+)/$1/eeg }; 1546 } 1547 $line =~ s|$s|$tmp|; 1548 } 1549 print DEST $line; 1550 } 1551 close(FILE); 1552 close(DEST); 1553 } 270 =item B<pb_log_init> 271 272 This function initializes the global variables used by the pb_log function. 273 274 The first parameter is the debug level which will be considered during the run of the program? 275 The second parameter is a pointer on a file descriptor used to print the log info. 276 277 =cut 1554 278 1555 279 sub pb_log_init { … … 1568 292 } 1569 293 1570 # 1571 # Return the list of packages we are working on in a CMS action 1572 # 1573 sub pb_cms_get_pkg { 1574 1575 my @pkgs = (); 1576 my $defpkgdir = shift || undef; 1577 my $extpkgdir = shift || undef; 1578 1579 # Get packages list 1580 if (not defined $ARGV[0]) { 1581 @pkgs = keys %$defpkgdir if (defined $defpkgdir); 1582 } elsif ($ARGV[0] =~ /^all$/) { 1583 @pkgs = keys %$defpkgdir if (defined $defpkgdir); 1584 push(@pkgs, keys %$extpkgdir) if (defined $extpkgdir); 1585 } else { 1586 @pkgs = @ARGV; 1587 } 1588 pb_log(0,"Packages: ".join(',',@pkgs)."\n"); 1589 return(\@pkgs); 1590 } 1591 1592 # 1593 # Return the list of packages we are working on in a non CMS action 1594 # 1595 sub pb_get_pkg { 1596 1597 my @pkgs = (); 1598 1599 my ($var) = pb_conf_read("$ENV{'PBDESTDIR'}/$ENV{'PBPROJVER'}-$ENV{'PBPROJTAG'}.pb","pbpkg"); 1600 @pkgs = keys %$var; 1601 1602 pb_log(0,"Packages: ".join(',',@pkgs)."\n"); 1603 return(\@pkgs); 1604 } 1605 1606 # 1607 # Check pbconf/project cms compliance 1608 # 1609 sub pb_cms_compliant { 1610 1611 my $param = shift; 1612 my $envar = shift; 1613 my $defdir = shift; 1614 my $uri = shift; 1615 my $pbinit = shift; 1616 my %pdir; 1617 1618 my ($pdir) = pb_conf_get_if($param) if (defined $param); 1619 if (defined $pdir) { 1620 %pdir = %$pdir; 1621 } 1622 1623 1624 if ((defined $pdir) && (%pdir) && (defined $pdir{$ENV{'PBPROJ'}})) { 1625 # That's always the environment variable that will be used 1626 $ENV{$envar} = $pdir{$ENV{'PBPROJ'}}; 1627 } else { 1628 if (defined $param) { 1629 pb_log(1,"WARNING: no $param defined, using $defdir\n"); 1630 pb_log(1," Please create a $param reference for project $ENV{'PBPROJ'} in $ENV{'PBETC'}\n"); 1631 pb_log(1," if you want to use another directory\n"); 1632 } 1633 $ENV{$envar} = "$defdir"; 1634 } 1635 1636 # Expand potential env variable in it 1637 eval { $ENV{$envar} =~ s/(\$ENV.+\})/$1/eeg }; 1638 pb_log(2,"$envar: $ENV{$envar}\n"); 1639 1640 my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri); 1641 1642 if ((! -d "$ENV{$envar}") || (defined $pbinit)) { 1643 if (defined $pbinit) { 1644 pb_mkdir_p("$ENV{$envar}"); 1645 } else { 1646 pb_log(1,"Checking out $uri\n"); 1647 pb_cms_checkout($scheme,$uri,$ENV{$envar}); 1648 } 1649 } elsif (($scheme !~ /^cvs/) || ($scheme !~ /^svn/)) { 1650 # Do not compare if it's not a real cms 1651 return; 1652 } else { 1653 pb_log(1,"$uri found locally, checking content\n"); 1654 my $cmsurl = pb_cms_get_uri($scheme,$ENV{$envar}); 1655 my ($scheme2, $account2, $host2, $port2, $path2) = pb_get_uri($cmsurl); 1656 if ($cmsurl ne $uri) { 1657 # The local content doesn't correpond to the repository 1658 pb_log(0,"ERROR: Inconsistency detected:\n"); 1659 pb_log(0," * $ENV{$envar} refers to $cmsurl but\n"); 1660 pb_log(0," * $ENV{'PBETC'} refers to $uri\n"); 1661 die "Project $ENV{'PBPROJ'} is not Project-Builder compliant."; 1662 } else { 1663 pb_log(1,"Content correct - doing nothing - you may want to update your repository however\n"); 1664 # they match - do nothing - there may be local changes 1665 } 1666 } 1667 } 1668 1669 sub pb_changelog { 1670 1671 my $dtype = shift; 1672 my $pkg = shift; 1673 my $pbver = shift; 1674 my $pbtag = shift; 1675 my $dsuf = shift; 1676 my $path = shift; 1677 my $OUTPUT = shift; 1678 my $doit = shift; 1679 my $chglog = shift || undef; 1680 1681 my $log = ""; 1682 1683 # For date handling 1684 $ENV{LANG}="C"; 1685 1686 if ((not (defined $dtype)) || ($dtype eq "") || 1687 (not (defined $pkg)) || ($pkg eq "") || 1688 (not (defined $pbver)) || ($pbver eq "") || 1689 (not (defined $pbtag)) || ($pbtag eq "") || 1690 (not (defined $dsuf)) || ($dsuf eq "") || 1691 (not (defined $path)) || ($path eq "") || 1692 (not (defined $OUTPUT)) || ($OUTPUT eq "") || 1693 (not (defined $doit)) || ($doit eq "")) { 1694 print $OUTPUT "\n"; 1695 return; 1696 } 1697 1698 if (((not defined $chglog) || (! -f $chglog)) && ($doit eq "yes")) { 1699 #pb_log(2,"No ChangeLog file ($chglog) for $pkg\n"; 1700 print $OUTPUT "\n"; 1701 return; 1702 } 1703 1704 my $date; 1705 my $ndate; 1706 my $n2date; 1707 my $ver; 1708 my $ver2; 1709 my ($pbpackager) = pb_conf_get("pbpackager"); 1710 1711 if (not defined $pbpackager->{$ENV{'PBPROJ'}}) { 1712 $pbpackager->{$ENV{'PBPROJ'}} = "undefined\@noproject.noorg"; 1713 } 1714 1715 # If we don't need to do it, or don't have it fake something 1716 if (((not defined $chglog) || (! -f $chglog)) && ($doit ne "yes")) { 1717 my @date=(localtime->sec(), localtime->min(), localtime->hour(), localtime->mday(), localtime->mon(), localtime->year(), localtime->wday(), localtime->yday(), localtime->isdst()); 1718 $date = strftime("%Y-%m-%d", @date); 1719 $ndate = UnixDate($date,"%a", "%b", "%d", "%Y"); 1720 $n2date = &UnixDate($date,"%a, %d %b %Y %H:%M:%S %z"); 1721 if (($dtype eq "rpm") || ($dtype eq "fc")) { 1722 $ver2 = "$pbver-$pbtag$dsuf"; 1723 print $OUTPUT "* $ndate $pbpackager->{$ENV{'PBPROJ'}} $ver2\n"; 1724 print $OUTPUT "- Updated to $pbver\n"; 1725 } 1726 if ($dtype eq "deb") { 1727 print $OUTPUT "$pkg ($pbver) unstable; urgency=low\n"; 1728 print $OUTPUT "\n"; 1729 print $OUTPUT " -- $pbpackager->{$ENV{'PBPROJ'}} $n2date\n\n\n"; 1730 } 1731 return; 1732 } 1733 1734 open(INPUT,"$chglog") || die "Unable to open $chglog (read)"; 1735 1736 # Skip first 4 lines 1737 my $tmp = <INPUT>; 1738 $tmp = <INPUT>; 1739 $tmp = <INPUT>; 1740 if ($dtype eq "announce") { 1741 print $OUTPUT $tmp; 1742 } 1743 $tmp = <INPUT>; 1744 if ($dtype eq "announce") { 1745 print $OUTPUT $tmp; 1746 } 1747 1748 my $first=1; 1749 1750 # Handle each block separated by newline 1751 while (<INPUT>) { 1752 ($ver, $date) = split(/ /); 1753 $ver =~ s/^v//; 1754 chomp($date); 1755 $date =~ s/\(([0-9-]+)\)/$1/; 1756 #pb_log(2,"**$date**\n"; 1757 $ndate = UnixDate($date,"%a", "%b", "%d", "%Y"); 1758 $n2date = &UnixDate($date,"%a, %d %b %Y %H:%M:%S %z"); 1759 #pb_log(2,"**$ndate**\n"; 1760 1761 if (($dtype eq "rpm") || ($dtype eq "fc")) { 1762 if ($ver !~ /-/) { 1763 if ($first eq 1) { 1764 $ver2 = "$ver-$pbtag$dsuf"; 1765 $first=0; 1766 } else { 1767 $ver2 = "$ver-1$dsuf"; 1768 } 1769 } else { 1770 $ver2 = "$ver$dsuf"; 1771 } 1772 print $OUTPUT "* $ndate $pbpackager->{$ENV{'PBPROJ'}} $ver2\n"; 1773 print $OUTPUT "- Updated to $ver\n"; 1774 } 1775 if ($dtype eq "deb") { 1776 print $OUTPUT "$pkg ($ver) unstable; urgency=low\n"; 1777 print $OUTPUT "\n"; 1778 } 1779 1780 $tmp = <INPUT>; 1781 while ($tmp !~ /^$/) { 1782 if ($dtype eq "deb") { 1783 $tmp =~ s/^- //; 1784 print $OUTPUT " * $tmp"; 1785 } elsif ($dtype eq "rpm") { 1786 print $OUTPUT "$tmp"; 1787 } else { 1788 print $OUTPUT "$tmp"; 1789 } 1790 last if (eof(INPUT)); 1791 $tmp = <INPUT>; 1792 } 1793 print $OUTPUT "\n"; 1794 1795 if ($dtype eq "deb") { 1796 # Cf: http://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog 1797 print $OUTPUT " -- $pbpackager->{$ENV{'PBPROJ'}} $n2date\n\n\n"; 1798 } 1799 1800 last if (eof(INPUT)); 1801 last if ($dtype eq "announce"); 1802 } 1803 close(INPUT); 1804 } 294 # cat equivalent function 295 sub pb_display_file { 296 297 my $file=shift; 298 299 return if (not -f $file); 300 printf "%s\n",pb_get_content($file); 301 } 302 303 # get content of a file in a variable 304 sub pb_get_content { 305 306 my $file=shift; 307 308 my $bkp = $/; 309 undef $/; 310 open(R,$file) || die "Unable to open $file: $!"; 311 my $content=<R>; 312 close(R); 313 chomp($content); 314 $/ = $bkp; 315 return($content); 316 } 317 1805 318 1; -
devel/pb/lib/ProjectBuilder/Distribution.pm
r391 r395 9 9 10 10 use strict; 11 use ProjectBuilder::Base; 11 12 12 13 # Inherit from the "Exporter" module which handles exporting functions. … … 55 56 =over 4 56 57 58 57 59 =item B<pb_get_distro> 58 60 … … 61 63 On my home machine it would currently report ("mandriva","2008.0"). 62 64 63 =item B<pb_distro_init>64 65 This function returns a list of 5 parameters indicating the distribution name, version, family, type of build system and suffix of packages of the underlying Linux distribution. The value of the 5 fields may be "unknown" in case the function was unable to recognize on which distribution it is running.66 67 As an example, Ubuntu and Debian are in the same "du" family. As well as RedHat, RHEL, CentOS, fedora are on the same "rh" family.68 Mandriva, Open SuSE and Fedora have all the same "rpm" type of build system. Ubuntu ad Debian have the same "deb" type of build system.69 And "fc" is the extension generated for all Fedora packages (Version will be added by pb).70 71 When passing the distribution name and version as parameters, the B<pb_distro_init> function returns the parameter of that distribution instead of the underlying one.72 73 =back74 75 =head1 WEB SITES76 77 The main Web site of the project is available at L<http://www.project-builder.org/>. Bug reports should be filled using the trac instance of the project at L<http://trac.project-builder.org/>.78 79 =head1 USER MAILING LIST80 81 None exists for the moment.82 83 =head1 AUTHORS84 85 The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>.86 87 =head1 COPYRIGHT88 89 Project-Builder.org is distributed under the GPL v2.0 license90 described in the file C<COPYING> included with the distribution.91 92 65 =cut 93 94 66 95 67 sub pb_distro_init { … … 176 148 } 177 149 150 =item B<pb_distro_init> 151 152 This function returns a list of 5 parameters indicating the distribution name, version, family, type of build system and suffix of packages of the underlying Linux distribution. The value of the 5 fields may be "unknown" in case the function was unable to recognize on which distribution it is running. 153 154 As an example, Ubuntu and Debian are in the same "du" family. As well as RedHat, RHEL, CentOS, fedora are on the same "rh" family. 155 Mandriva, Open SuSE and Fedora have all the same "rpm" type of build system. Ubuntu ad Debian have the same "deb" type of build system. 156 And "fc" is the extension generated for all Fedora packages (Version will be added by pb). 157 158 When passing the distribution name and version as parameters, the B<pb_distro_init> function returns the parameter of that distribution instead of the underlying one. 159 160 Cf: http://linuxmafia.com/faq/Admin/release-files.html 161 Ideas taken from http://search.cpan.org/~kerberus/Linux-Distribution-0.14/lib/Linux/Distribution.pm 162 163 =cut 164 178 165 sub pb_get_distro { 179 180 # Cf: http://linuxmafia.com/faq/Admin/release-files.html181 # Ideas taken from182 # http://search.cpan.org/~kerberus/Linux-Distribution-0.14/lib/Linux/Distribution.pm183 166 184 167 my $base="/etc"; … … 325 308 } 326 309 327 # get content of a file in a variable 328 sub pb_get_content { 329 330 my $file=shift; 331 332 my $bkp = $/; 333 undef $/; 334 open(R,$file) || die "Unable to open $file: $!"; 335 my $content=<R>; 336 close(R); 337 chomp($content); 338 $/ = $bkp; 339 return($content); 340 } 310 =back 311 312 =head1 WEB SITES 313 314 The main Web site of the project is available at L<http://www.project-builder.org/>. Bug reports should be filled using the trac instance of the project at L<http://trac.project-builder.org/>. 315 316 =head1 USER MAILING LIST 317 318 None exists for the moment. 319 320 =head1 AUTHORS 321 322 The Project-Builder.org team L<http://trac.project-builder.org/> lead by Bruno Cornec L<mailto:bruno@project-builder.org>. 323 324 =head1 COPYRIGHT 325 326 Project-Builder.org is distributed under the GPL v2.0 license 327 described in the file C<COPYING> included with the distribution. 328 329 =cut 330 331 341 332 1;
Note:
See TracChangeset
for help on using the changeset viewer.