Changeset 395 in ProjectBuilder for devel/pb/lib/ProjectBuilder/Base.pm


Ignore:
Timestamp:
Apr 18, 2008, 7:32:09 PM (16 years ago)
Author:
Bruno Cornec
Message:
  • Move all reusable functions into Base
  • Move all pb only functions into pb
  • pod doc for Base begining
File:
1 edited

Legend:

Unmodified
Added
Removed

  • devel/pb/lib/ProjectBuilder/Base.pm

    r383 r395  
    11#!/usr/bin/perl -w
    22#
    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
    48#
    59# $Id$
    … …  
    1014use strict;
    1115use lib qw (lib);
    12 use File::Basename;
    1316use File::Path;
    14 use File::stat;
    15 use File::Copy;
    1617use File::Temp qw(tempdir);
    1718use Data::Dumper;
    18 use POSIX qw(strftime);
    1919use Time::localtime qw(localtime);
    20 use Date::Manip;
    2120use English;
    2221
    … …  
    3231
    3332our @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
     33our @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
     39ProjectBuilder::Base, part of the project-builder.org - module dealing with generic functions suitable for perl project development
     40
     41=head1 DESCRIPTION
     42
     43This 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
     98Internal mkdir -p function. Forces mode to 755. Supports multiple parameters.
     99Based in File::Path mkpath.
     100
     101=cut
     102
    831103sub pb_mkdir_p {
    832104my @dir = @_;
    … …  
    835107}
    836108
    837 # Internal rm -rf function
     109=item B<pb_mkdir_p>
     110
     111Internal rm -rf function. Supports multiple parameters.
     112Based in File::Path rmtree.
     113
     114=cut
     115
    838116sub pb_rm_rf {
    839117my @dir = @_;
    … …  
    842120}
    843121
    844 # Internal system function
     122=item B<pb_system>
     123
     124Encapsulate the "system" call for better output and return value test
     125Needs a $ENV{'PBTMP'} variable which is created by calling the pb_mktemp_init function
     126Needs pb_log support, so pb_log_init should have benn called before.
     127
     128The first parameter is the shell command to call.
     129The second parameter is the message to print on screen. If none is given, then the command is printed.
     130This function returns the result the return value of the system command.
     131If no error reported, it prints OK on the screen, just after the message. Else it prints the errors generated.
     132
     133=cut
     134
    845135sub pb_system {
    846136
    … …  
    849139
    850140pb_log(0,"$cmt... ");
    851 #system("$cmd 2>&1 > $ENV{'PBTMP'}/system.log");
     141pb_log(1,"Executing $cmd\n");
    852142system($cmd);
    853 pb_log(1,"Executing $cmd\n");
    854143my $res = $?;
    855144if ($res == -1) {
    … …  
    868157}
    869158
    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
     161This function returns a table of pointers on hashes
     162corresponding to the keys in a configuration file passed in parameter.
     163If that file doesn't exist, it returns undef.
     164
     165The format of the configuration file is as follows:
     166
     167key tag = value1,value2,...
     168
     169Supposing the file is called "$ENV{'HOME'}/.pbrc", containing the following:
     170
     171$ cat $HOME/.pbrc
     172pbver pb = 3
     173pbver default = 1
     174pblist pb = 12,25
     175
     176calling it like this:
     177
     178my ($k1, $k2) = pb_conf_read_if("$ENV{'HOME'}/.pbrc","pbver","pblist");
     179
     180will allow to get the mapping
     181$k1->{'pb'}  contains 3
     182$ka->{'default'} contains 1
     183$k2->{'pb'} contains 12,25
     184
     185Valid chars for keys and tags are letters, numbers, '-' and '_'.
     186
     187=cut
     188
    962189sub pb_conf_read_if {
    963190
    … …  
    970197}
    971198
    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
     201This 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
    974205sub pb_conf_read {
    975206
    … …  
    995226}
    996227
    997 # Analyze a url passed and return protocol, account, password, server, port, path
     228=item B<pb_get_uri>
     229
     230This function returns a list of 6 parameters indicating the protocol, account, password, server, port, and path contained in the URI passed in parameter.
     231
     232A URI has the format protocol://[ac@]host[:port][path[?query][#fragment]].
     233Cf man URI.
     234
     235=cut
     236
    998237sub pb_get_uri {
    999238
    … …  
    1001240
    1002241pb_log(2,"DEBUG: uri:$uri\n");
    1003 # A URL has the format protocol://[ac@]host[:port][path[?query][#fragment]].
    1004 # Cf man URI
    1005242my ($scheme, $authority, $path, $query, $fragment) =
    1006243         $uri =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?| if (defined $uri);
    … …  
    1018255}
    1019256
    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
     259This 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
     261Cf: man ctime and description of the struct tm.
     262
     263=cut
    1073264
    1074265sub pb_get_date {
    … …  
    1077268}
    1078269
    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
     272This function initializes the global variables used by the pb_log function.
     273
     274The first parameter is the debug level which will be considered during the run of the program?
     275The second parameter is a pointer on a file descriptor used to print the log info.
     276
     277=cut
    1554278
    1555279sub pb_log_init {
    … …  
    1568292}
    1569293
    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
     295sub pb_display_file {
     296
     297my $file=shift;
     298
     299return if (not -f $file);
     300printf "%s\n",pb_get_content($file);
     301}
     302
     303# get content of a file in a variable
     304sub pb_get_content {
     305
     306my $file=shift;
     307
     308my $bkp = $/;
     309undef $/;
     310open(R,$file) || die "Unable to open $file: $!";
     311my $content=<R>;
     312close(R);
     313chomp($content);
     314$/ = $bkp;
     315return($content);
     316}
     317
    18053181;
Note: See TracChangeset for help on using the changeset viewer.