Changeset 318


Ignore:
Timestamp:
Feb 10, 2008, 4:37:43 PM (12 years ago)
Author:
bruno
Message:

First success with collectl

Location:
devel/pb
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • devel/pb/bin/pb

    r316 r318  
    2323use ProjectBuilder::Distribution qw (pb_distro_init);
    2424use ProjectBuilder::Version qw (pb_version_init);
    25 use ProjectBuilder::Base qw (pb_conf_read pb_conf_get 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_get_date pb_log pb_log_init pb_get_pkg);
     25use ProjectBuilder::Base;
    2626
    2727my %opts;                   # CLI Options
     
    3636my %pbtag;                  # per package
    3737my $pbrev;                  # Global REVISION variable
    38 my @date=pb_get_date();
     38my @date = pb_get_date();
    3939my $pbdate = strftime("%Y-%m-%d", @date);
    40 my $debug = 0;
    4140my $pbaccount;              # Login to use to connect to the VM
    4241my $pbport;                 # Port to use to connect to the VM
    4342my $newver;                 # New version to create
    4443my $iso;                    # ISO iage for the VM to create
    45 my $LOG = \*STDOUT;
    4644
    4745getopts('a:hi:l:m:P:p:qr:s:tvV:',\%opts);
     
    5351}
    5452if (defined $opts{'v'}) {
    55     $debug++;
     53    $debug = 2;
     54    #$debug = $opts{'v'};
     55    pb_log(0,"Debug value: $debug\n");
    5656}
    5757if (defined $opts{'q'}) {
  • devel/pb/lib/ProjectBuilder/Base.pm

    r317 r318  
    55# $Id$
    66#
     7
     8package ProjectBuilder::Base;
    79
    810use strict;
     
    1113use File::Path;
    1214use File::Copy;
    13 use File::Temp qw /tempdir/;
     15use File::Temp qw(tempdir);
    1416use Data::Dumper;
    1517use POSIX qw(strftime);
     18use Time::localtime qw(localtime);
    1619
    1720use ProjectBuilder::Changelog qw (pb_changelog);
    1821
     22# Inherit from the "Exporter" module which handles exporting functions.
     23 
     24use Exporter;
     25 
     26# Export, by default, all the functions into the namespace of
     27# any code which uses this module.
     28 
     29our $debug = 0;
     30our $LOG = \*STDOUT;
     31
     32our @ISA = qw(Exporter);
     33our @EXPORT = qw(pb_env_init pb_conf_read 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_get_date pb_log pb_log_init pb_get_pkg $debug $LOG);
     34
    1935$ENV{'PBETC'} = "$ENV{'HOME'}/.pbrc";
    20 
    21 my $debug = 0;
    22 my $LOG = \*STDOUT;
    2336
    2437sub pb_env_init {
     
    5366    if (defined $proj) {
    5467        pb_log(0,"WARNING: using $proj as default project as none has been specified\n");
    55         pb_log(0,"Please create a pbconf reference for project $proj in $ENV{'PBETC'}\nif you want to use another project\n");
     68        pb_log(0,"         Please either create a pbconf reference for project $proj in $ENV{'PBETC'}\n");
     69        pb_log(0,"         or call pb with the -p project option if you want to use another project\n");
    5670    }
    5771}
     
    6074# That's always the environment variable that will be used
    6175$ENV{'PBPROJ'} = $proj;
     76pb_log(2,"PBPROJ: $ENV{'PBPROJ'}\n");
    6277
    6378if (not defined ($pbconf{$ENV{'PBPROJ'}})) {
     
    103118    if ((not defined $pbdir) || (not defined $pbdir{$ENV{'PBPROJ'}})) {
    104119        pb_log(0,"WARNING: no pbdir defined, using /var/cache\n");
    105         pb_log(0,"Please create a pbdir reference for project $ENV{'PBPROJ'} in $ENV{'PBETC'}\nif you want to use another directory\n");
     120        pb_log(0,"         Please create a pbdir reference for project $ENV{'PBPROJ'} in $ENV{'PBETC'}\n");
     121        pb_log(0,"         if you want to use another directory\n");
    106122        $ENV{'PBDIR'} = "/var/cache";
    107123    } else {
     
    113129eval { $ENV{'PBDIR'} =~ s/(\$ENV.+\})/$1/eeg };
    114130
     131pb_log(2,"PBDIR: $ENV{'PBDIR'}\n");
    115132#
    116133# Set delivery directory
     
    118135$ENV{'PBDESTDIR'}="$ENV{'PBDIR'}/$ENV{'PBPROJ'}/delivery";
    119136
     137pb_log(2,"PBDESTDIR: $ENV{'PBDESTDIR'}\n");
    120138#
    121139# Removes all directory existing below the delivery dir
     
    146164}
    147165
     166pb_log(2,"PBBUILDDIR: $ENV{'PBBUILDDIR'}\n");
    148167#
    149168# Set temp directory
     
    153172}
    154173$ENV{'PBTMP'} = tempdir( "pb.XXXXXXXXXX", DIR => $ENV{'TMPDIR'}, CLEANUP => 1 );
     174pb_log(2,"PBTMP: $ENV{'PBTMP'}\n");
    155175
    156176#
     
    158178#
    159179$ENV{'PBCONF'} = "$ENV{'PBDIR'}/$ENV{'PBPROJ'}/pbconf";
     180pb_log(2,"PBCONF: $ENV{'PBCONF'}\n");
    160181
    161182my ($scheme, $account, $host, $port, $path) = pb_get_uri($pbconf{$ENV{'PBPROJ'}});
    162183
    163 if ((not -d "$ENV{'PBCONF'}") || (defined $pbinit)) {
     184if ((! -d "$ENV{'PBCONF'}") || (defined $pbinit)) {
    164185    pb_log(1,"Checking out pbconf\n");
    165186    pb_cms_checkout($scheme,$pbconf{$ENV{'PBPROJ'}},$ENV{'PBCONF'});
     
    167188    pb_log(1,"pbconf found, checking content\n");
    168189    my $cmsurl = pb_cms_getinfo($scheme,$ENV{'PBCONF'},"URL:");
    169     if ($cmsurl !~ /^$scheme/) {
    170         pb_log(1,"Content irrelevant, cleaning up and checking it out\n");
     190    my ($scheme2, $account2, $host2, $port2, $path2) = pb_get_uri($cmsurl);
     191    if ($scheme2 ne $scheme) {
     192        pb_log(1,"WARNING: Content of $ENV{'PBCONF'} irrelevant, cleaning up and checking it out\n");
    171193        pb_rm_rf("$ENV{'PBCONF'}");
    172194        pb_cms_checkout($scheme,$pbconf{$ENV{'PBPROJ'}},$ENV{'PBCONF'});
     
    174196        # The local content doesn't correpond to the repository
    175197        pb_log(0,"ERROR: Inconsistency detected:\n");
    176         pb_log(0,"* $ENV{'PBCONF'} refers to $cmsurl but\n");
    177         pb_log(0,"* $ENV{'PBETC'} refers to $pbconf{$ENV{'PBPROJ'}}\n");
     198        pb_log(0,"       * $ENV{'PBCONF'} refers to $cmsurl but\n");
     199        pb_log(0,"       * $ENV{'PBETC'} refers to $pbconf{$ENV{'PBPROJ'}}\n");
    178200        die "Project $ENV{'PBPROJ'} is not Project-Builder compliant.";
    179201    } else {
     
    194216                          = stat($d);
    195217            # Keep the most recent
     218            pb_log(2,"Looking at $d: $mtime\n");
    196219            if ($mtime > $maxmtime) {
    197220                $ENV{'PBROOT'} = "$ENV{'PBCONF'}/$d";
     
    202225        die "No directory found under $ENV{'PBCONF'}" if (not defined $ENV{'PBROOT'});
    203226        pb_log(0,"WARNING: no pbroot defined, using $ENV{'PBROOT'}\n");
    204         pb_log(0,"Please use -r release if you want to use another release\n");
     227        pb_log(0,"         Please use -r release if you want to use another release\n");
    205228    } else {
    206229        my ($pbroot) = pb_conf_read_if("$ENV{'PBDESTDIR'}/pbrc","pbroot");
     
    848871
    849872# Everything is returned via ptr1
    850 my @ptr1 = pb_conf_read_if("$ENV{'PBETC'}", @param);
    851 my @ptr2 = pb_conf_read_if("$ENV{'PBROOT'}/$ENV{'PBPROJ'}.pb", @param);
     873my @ptr1 = ();
     874my @ptr2 = ();
     875@ptr1 = pb_conf_read_if("$ENV{'PBETC'}", @param) if (defined $ENV{'PBETC'});
     876@ptr2 = pb_conf_read_if("$ENV{'PBROOT'}/$ENV{'PBPROJ'}.pb", @param) if ((defined $ENV{'PBROOT'}) and (defined $ENV{'PBPROJ'}));
    852877
    853878my $p1;
     
    938963my $uri = shift || undef;
    939964
     965pb_log(2,"DEBUG: uri:$uri\n");
    940966# A URL has the format protocol://[ac@]host[:port][path[?query][#fragment]].
    941967# Cf man URI
    942968my ($scheme, $authority, $path, $query, $fragment) =
    943          $uri =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
    944 my ($account,$host,$port) = $authority =~ m|(?:([^\@]+)\@)?([^:]+)(:(?:[0-9]+))?|;
     969         $uri =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?| if (defined $uri);
     970my ($account,$host,$port) = $authority =~ m|(?:([^\@]+)\@)?([^:]+)(:(?:[0-9]+))?| if (defined $authority);
     971
     972$scheme = "" if (not defined $scheme);
     973$authority = "" if (not defined $authority);
     974$path = "" if (not defined $path);
     975$account = "" if (not defined $account);
     976$host = "" if (not defined $host);
     977$port = "" if (not defined $port);
     978
    945979pb_log(2,"DEBUG: scheme:$scheme ac:$account host:$host port:$port path:$path\n");
    946980return($scheme, $account, $host, $port, $path);
     
    9861020    # Try to make it easy for us
    9871021    #pb_log(2,"WARNING: Assuming a local project under $ENV{'PBDIR'}/$ENV{'PBPROJ'}:\n");
    988     #pb_log(2,"If not, pleaase setup a pbproj entry in $ENV{'PBROOT'}/$ENV{'PBPROJ'}.pb\n");
     1022    #pb_log(2,"         If not, pleaase setup a pbproj entry in $ENV{'PBROOT'}/$ENV{'PBPROJ'}.pb\n");
    9891023    #return("");
    9901024#}
     
    11071141
    11081142sub pb_cms_getinfo {
     1143
    11091144my $scheme = shift;
    11101145my $dir = shift;
     
    11191154        ($void,$res) = split(/^$info/) if (/^$info/);
    11201155    }
     1156    $res =~ s/^\s*//;
    11211157    close(PIPE);
    11221158    chomp($res);
     
    11261162    die "cms $scheme unknown";
    11271163}
     1164pb_log(2,"Found CMS info: $res\n");
    11281165return($res);
    11291166}
     
    13781415my $msg = shift;
    13791416
    1380 print $LOG "$msg\n" if ($dlevel <= $debug);
     1417print $LOG "$msg" if ($dlevel <= $debug);
    13811418}
    13821419
Note: See TracChangeset for help on using the changeset viewer.