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


Ignore:
Timestamp:
Mar 2, 2008, 12:25:28 AM (16 years ago)
Author:
Bruno Cornec
Message:
  • Improvements for CMS support in 0.9.x serie (lots on CVS)
  • Use pod for pb documentation (modules to be done)
  • Use Getopt::Long and support now long options
  • pb_syntax now uses pod2usage
File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r328 r331  
    3232
    3333our @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_get_date pb_log pb_log_init pb_get_pkg pb_cms_compliant $debug $LOG);
     34our @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_get_date pb_log pb_log_init pb_get_pkg pb_cms_compliant pb_get_uri pb_cms_get_uri $debug $LOG);
    3535
    3636$ENV{'PBETC'} = "$ENV{'HOME'}/.pbrc";
    … …  
    8787# Tree will look like this:
    8888#
    89 #             maint pbdefdir                         PBDEFDIR            dev dir (optional)   PBDEVDIR
     89#             maint pbdefdir                         PBDEFDIR            dev dir (optional)
    9090#                  |                                                        |
    9191#            ------------------------                                --------------------
    9292#            |                      |                                |                  |
    93 #         pbproj1                pbproj2             PBPROJ       pbproj1           pbproj2   PBDEVPROJ
     93#         pbproj1                pbproj2             PBPROJ       pbproj1           pbproj2
    9494#            |                                                       |
    9595#  ---------------------------------------------                ----------
    9696#  *      *        *       |        |          |                *        *
    97 # tag    dev    pbconf    ...     build     delivery PBCONF    dev      tag                   PBDEVROOT
     97# tag    dev    pbconf    ...     build     delivery PBCONF    dev      tag                 
    9898#  |               |                           |     PBDESTDIR           |
    9999#  ---          ------                        pbrc   PBBUILDDIR       -------
    100100#    |          |    |                                                |     |
    101 #   1.1        dev  tag                              PBROOT          1.0   1.1
     101#   1.1        dev  tag                              PBROOT          1.0   1.1                PBDIR
    102102#                    |
    103103#                 -------
    … …  
    989989sub pb_cms_init {
    990990
    991 my $proj = shift || undef;
    992 
    993 # Use the project URI
    994 my ($uri) = pb_conf_get("pburl");
    995 
    996 # Extract values from that URI
    997 my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri->{$ENV{'PBPROJ'}});
     991my $scheme = shift || undef;
    998992
    999993if ($scheme =~ /^svn/) {
    1000     $ENV{'PBREVISION'}= pb_cms_getinfo($scheme,$uri->{$ENV{'PBPROJ'}},"Revision:");
    1001     #$ENV{'PBREVISION'}=`(cd "$ENV{'PBDEVDIR'}" ; svnversion .)`;
     994    # svnversion more precise than svn info
     995    my $tmp = `(cd "$ENV{'PBDIR'}" ; svnversion .)`;
     996    chomp($tmp);
     997    $ENV{'PBREVISION'}=$tmp;
    1002998    $ENV{'PBCMSLOGFILE'}="svn.log";
    1003999} elsif (($scheme eq "file") || ($scheme eq "ftp") || ($scheme eq "http")) {
    10041000    $ENV{'PBREVISION'}="flat";
    10051001    $ENV{'PBCMSLOGFILE'}="flat.log";
    1006 } elsif ($scheme eq "cvs") {
     1002} elsif ($scheme =~ /^cvs/) {
    10071003    # Way too slow
    10081004    #$ENV{'PBREVISION'}=`(cd "$ENV{'PBROOT'}" ; cvs rannotate  -f . 2>&1 | awk '{print \$1}' | grep -E '^[0-9]' | cut -d. -f2 |sort -nu | tail -1)`;
    10091005    #chomp($ENV{'PBREVISION'});
    1010     $ENV{'PBREVISION'}="CVS";
     1006    $ENV{'PBREVISION'}="cvs";
    10111007    $ENV{'PBCMSLOGFILE'}="cvs.log";
    1012     #
    1013     # Export content if needed
    1014     #
    1015     my ($cvsrsh) = pb_conf_get_if("cvsrsh");
    1016     $ENV{'CVS_RSH'} = $cvsrsh->{$proj} if (defined $cvsrsh->{$proj});
     1008    $ENV{'CVS_RSH'} = "ssh" if ($scheme =~ /ssh/);
    10171009} else {
    10181010    die "cms $scheme unknown";
    10191011}
    1020 
    1021 return($scheme,$uri->{$ENV{'PBPROJ'}});
    10221012}
    10231013
    … …  
    10991089        pb_rm_rf("$destdir/$d0");
    11001090    }
    1101 } elsif ($scheme eq "cvs") {
     1091} elsif ($scheme =~ /^cvs/) {
     1092    # CVS needs a relative path !
    11021093    my $dir=dirname($destdir);
    11031094    my $base=basename($destdir);
     1095    # CVS also needs a modules name not a dir
    11041096    if (-d $source) {
    11051097        $tmp1 = $source;
    11061098        $tmp1 =~ s|$ENV{'PBROOT'}/||;
     1099        $tmp1 =~ s|$ENV{'PBDIR'}/||;
    11071100    } else {
    11081101        $tmp1 = dirname($source);
    11091102        $tmp1 =~ s|$ENV{'PBROOT'}/||;
     1103        $tmp1 =~ s|$ENV{'PBDIR'}/||;
    11101104        $tmp1 = $tmp1."/".basename($source);
    11111105    }
    1112     # CVS needs a relative path !
    1113     my ($cvsroot) = pb_conf_get("cvsroot");
    11141106    my $pbdate = strftime("%Y-%m-%d %H:%M:%S", @date);
    1115     pb_system("cd $dir ; cvs -d $cvsroot->{$ENV{'PBPROJ'}} export -D \"$pbdate\" -d $base $tmp1","Exporting $source from CVS to $destdir");
     1107    pb_system("cd $dir ; cvs -d $account\@$host:$path export -D \"$pbdate\" -d $base $tmp1","Exporting $source from CVS to $destdir");
    11161108} else {
    11171109    die "cms $scheme unknown";
    … …  
    11681160    if (! -f "$dest/ChangeLog") {
    11691161        if (-x "/usr/bin/svn2cl") {
     1162            # In case we have no network, just create an empty one before to allow correct build
     1163            open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog";
     1164            close(CL);
    11701165            pb_system("/usr/bin/svn2cl --group-by-day --authors=$authors -i -o $dest/ChangeLog $pkgdir","Generating ChangeLog from SVN with svn2cl");
    11711166        } else {
    … …  
    11781173        pb_system("echo ChangeLog for $pkgdir > $dest/ChangeLog","Empty ChangeLog file created");
    11791174    }
    1180 } elsif ($scheme eq "cvs") {
     1175} elsif ($scheme =~ /^cvs/) {
    11811176    my $tmp=basename($pkgdir);
    11821177    # CVS needs a relative path !
    11831178    if (! -f "$dest/ChangeLog") {
    11841179        if (-x "/usr/bin/cvs2cl") {
     1180            # In case we have no network, just create an empty one before to allow correct build
     1181            open(CL,"> $dest/ChangeLog") || die "Unable to create $dest/ChangeLog";
     1182            close(CL);
    11851183            pb_system("/usr/bin/cvs2cl --group-by-day -U $authors -f $dest/ChangeLog $pkgdir","Generating ChangeLog from CVS with cvs2cl");
    11861184        } else {
    … …  
    11941192}
    11951193
    1196 sub pb_cms_getinfo {
     1194sub pb_cms_get_uri {
    11971195
    11981196my $scheme = shift;
    11991197my $dir = shift;
    1200 my $info = shift || "URL:";
    12011198
    12021199my $res = "";
    … …  
    12061203    open(PIPE,"LANGUAGE=C svn info $dir |") || return("");
    12071204    while (<PIPE>) {
    1208         ($void,$res) = split(/^$info/) if (/^$info/);
     1205        ($void,$res) = split(/^URL:/) if (/^URL:/);
    12091206    }
    12101207    $res =~ s/^\s*//;
    … …  
    12121209    chomp($res);
    12131210} elsif ($scheme eq "flat") {
    1214 } elsif ($scheme eq "cvs") {
     1211    $res = "flat";
     1212} elsif ($scheme =~ /^cvs/) {
     1213    # This path is always the root path of CVS, but we may be below
     1214    open(FILE,"$dir/CVS/Root") || die "$dir isn't CVS controlled";
     1215    $res = <FILE>;
     1216    chomp($res);
     1217    close(FILE);
     1218    # Find where we are in the tree
     1219    my $rdir = $dir;
     1220    while ((! -d "$rdir/CVSROOT") && ($rdir ne "/")) {
     1221        $rdir = dirname($rdir);
     1222    }
     1223    die "Unable to find a CVSROOT dir in the parents of $dir" if (! -d "$rdir/CVSROOT");
     1224    #compute our place under that root dir - should be a relative path
     1225    $dir =~ s|^$rdir||;
     1226    my $suffix = "";
     1227    $suffix = "$dir" if ($dir ne "");
     1228
     1229    my $prefix = "";
     1230    if ($scheme =~ /ssh/) {
     1231        $prefix = "cvs+ssh://";
     1232    } else {
     1233        $prefix = "cvs://";
     1234    }
     1235    $res = $prefix.$res.$suffix;
    12151236} else {
    12161237    die "cms $scheme unknown";
    … …  
    12251246my $newurl = shift;
    12261247
    1227 if ($scheme eq "svn") {
     1248if ($scheme =~ /^svn/) {
    12281249    pb_system("svn copy -m \"Creation of $newurl from $oldurl\" $oldurl $newurl","Copying $oldurl to $newurl ");
    12291250} elsif ($scheme eq "flat") {
    1230 } elsif ($scheme eq "cvs") {
     1251} elsif ($scheme =~ /^cvs/) {
    12311252} else {
    12321253    die "cms $scheme unknown";
    … …  
    12421263    pb_system("svn co $url $destination","Checking out $url to $destination ");
    12431264} elsif ($scheme eq "flat") {
    1244 } elsif ($scheme eq "cvs") {
     1265} elsif ($scheme =~ /^cvs/) {
    12451266} else {
    12461267    die "cms $scheme unknown";
    … …  
    12531274
    12541275my $ver = basename($dir);
    1255 if ($scheme eq "svn") {
     1276if ($scheme =~ /^svn/) {
    12561277    pb_system("svn ci -m \"Updated to $ver\" $dir","Checking in $dir");
    12571278    pb_system("svn up $dir","Updating $dir");
    12581279} elsif ($scheme eq "flat") {
    1259 } elsif ($scheme eq "cvs") {
     1280} elsif ($scheme =~ /^cvs/) {
    12601281} else {
    12611282    die "cms $scheme unknown";
    … …  
    12661287my $scheme = shift;
    12671288
    1268 if ($scheme eq "svn") {
     1289if ($scheme =~ /^svn/) {
    12691290    open(PIPE,"svn diff $ENV{'PBROOT'} |") || die "Unable to get svn diff from $ENV{'PBROOT'}";
    12701291    my $l = 0;
    … …  
    12741295    return($l);
    12751296} elsif ($scheme eq "flat") {
    1276 } elsif ($scheme eq "cvs") {
     1297} elsif ($scheme =~ /^cvs/) {
    12771298} else {
    12781299    die "cms $scheme unknown";
    … …  
    15291550} else {
    15301551    pb_log(1,"$uri found locally, checking content\n");
    1531     my $cmsurl = pb_cms_getinfo($scheme,$ENV{$envar},"URL:");
     1552    my $cmsurl = pb_cms_get_uri($scheme,$ENV{$envar});
    15321553    my ($scheme2, $account2, $host2, $port2, $path2) = pb_get_uri($cmsurl);
    15331554    if ($cmsurl ne $uri) {
Note: See TracChangeset for help on using the changeset viewer.