Changeset 1469 in ProjectBuilder for devel


Ignore:
Timestamp:
Apr 16, 2012, 3:43:53 AM (13 years ago)
Author:
Bruno Cornec
Message:
  • Split CMS functions in 2 parts, one lowlevel reusable outside of pb in VCS.pm, the remaining stay in CMS.pm, part of pb.
Location:
devel
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed

  • devel/pb-modules/lib/ProjectBuilder/Env.pm

    r1464 r1469  
    2323use ProjectBuilder::Conf;
    2424use ProjectBuilder::CMS;
     25use ProjectBuilder::VCS;
    2526
    2627# Inherit from the "Exporter" module which handles exporting functions.
    … …  
    251252pb_log(2,"PBDEFDIR: $ENV{'PBDEFDIR'}\n");
    252253
    253 # Need to do that earlier as it's used potentialy in pb_cms_add
     254# Need to do that earlier as it's used potentialy in pb_vcs_add
    254255pb_temp_init($pbkeep);
    255256pb_log(2,"PBTMP: $ENV{'PBTMP'}\n");
    … …  
    263264        pb_mkdir_p("$ENV{'PBDEFDIR'}/$ENV{'PBPROJ'}");
    264265    }
    265     pb_cms_add($pbconf{$ENV{'PBPROJ'}},"$ENV{'PBDEFDIR'}/$ENV{'PBPROJ'}");
     266    pb_vcs_add($pbconf{$ENV{'PBPROJ'}},"$ENV{'PBDEFDIR'}/$ENV{'PBPROJ'}");
    266267}
    267268
    … …  
    574575
    575576# PBVER is replaced by the version (\$pb->{'ver'} in code)
    576 filter PBVER = \$pb->{'ver'}$pb->{'extdir'}
     577filter PBVER = \$pb->{'ver'}\$pb->{'extdir'}
    577578
    578579# PBDATE is replaced by the date (\$pb->{'date'} in code)
    … …  
    11841185   
    11851186            }
    1186             pb_cms_add($pbconf{$ENV{'PBPROJ'}},$ENV{'PBCONFDIR'});
     1187            pb_vcs_add($pbconf{$ENV{'PBPROJ'}},$ENV{'PBCONFDIR'});
    11871188            pb_cms_checkin($pbconf{$ENV{'PBPROJ'}},"$ENV{'PBDEFDIR'}/$ENV{'PBPROJ'}",$pbinit);
    11881189        } else {

  • devel/pb/bin/pb

    r1465 r1469  
    3232use ProjectBuilder::Conf;
    3333use ProjectBuilder::Distribution;
     34use ProjectBuilder::VCS;
    3435use ProjectBuilder::CMS;
    3536use ProjectBuilder::Env;
    … …  
    850851            }
    851852        }
    852         my $preserve = pb_cms_export($sourceuri,$sourcedir,$dest);
     853        my $preserve = pb_vcs_export($sourceuri,$sourcedir,$dest);
    853854
    854855        # Generated fake content for test versions to speed up stuff
    … …  
    998999                        foreach my $pf (split(/,/,$pb->{'patches'}->{$v})) {
    9991000                            my $pp = basename($pf);
    1000                             pb_cms_export($pf,undef,"$dest/pbconf/$v/pbpatch");
     1001                            pb_vcs_export($pf,undef,"$dest/pbconf/$v/pbpatch");
    10011002                            pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbpatch/$pp",$pb);
    10021003                            pb_system("gzip -9f $dest/pbconf/$v/pbpatch/$pp","","quiet");
    … …  
    10171018                        foreach my $pf (split(/,/,$pb->{'sources'}->{$v})) {
    10181019                            my $pp = basename($pf);
    1019                             pb_cms_export($pf,undef,"$dest/pbconf/$v/pbsrc");
     1020                            pb_vcs_export($pf,undef,"$dest/pbconf/$v/pbsrc");
    10201021                            pb_filter_file_inplace($ptr,"$dest/pbconf/$v/pbsrc/$pp",$pb);
    10211022                        }
    … …  
    26042605    }
    26052606
    2606     my $res = pb_cms_isdiff($scheme,$ENV{'PBROOTDIR'});
     2607    my $res = pb_vcs_isdiff($scheme,$ENV{'PBROOTDIR'});
    26072608    die "ERROR: No differences accepted in CMS for $ENV{'PBROOTDIR'} before creating a new version" if ($res != 0);
    26082609
    2609     $res = pb_cms_isdiff($scheme2,$ENV{'PBDIR'});
     2610    $res = pb_vcs_isdiff($scheme2,$ENV{'PBDIR'});
    26102611    die "ERROR: No differences accepted in CMS for $ENV{'PBDIR'} before creating a new version" if ($res != 0);
    26112612
    … …  
    26252626    # Duplicate and extract project-builder part
    26262627    pb_log(2,"Copying $uri/$oldver to $newurl\n");
    2627     pb_cms_copy($scheme,"$uri/$oldver",$newurl);
     2628    pb_vcs_copy($scheme,"$uri/$oldver",$newurl);
    26282629    pb_log(2,"Checkout $newurl to $ENV{'PBCONFDIR'}/$newver\n");
    2629     pb_cms_up($scheme,"$ENV{'PBCONFDIR'}");
     2630    pb_vcs_up($scheme,"$ENV{'PBCONFDIR'}");
    26302631
    26312632    # Duplicate and extract project
    … …  
    26332634
    26342635    pb_log(2,"Copying $pburl->{$ENV{'PBPROJ'}}/$oldver to $newurl2\n");
    2635     pb_cms_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$oldver",$newurl2);
     2636    pb_vcs_copy($scheme2,"$pburl->{$ENV{'PBPROJ'}}/$oldver",$newurl2);
    26362637
    26372638    my $tmp = $ENV{'PBDIR'};
    26382639    $tmp =~ s|$oldver$||;
    26392640    pb_log(2,"Checkout $newurl2 to $tmp/$newver\n");
    2640     pb_cms_up($scheme2,"$tmp");
     2641    pb_vcs_up($scheme2,"$tmp");
    26412642
    26422643    # Update the .pb file

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

    r1421 r1469  
    2222use ProjectBuilder::Base;
    2323use ProjectBuilder::Conf;
     24use ProjectBuilder::VCS;
    2425
    2526# Inherit from the "Exporter" module which handles exporting functions.
    … …  
    3233 
    3334our @ISA = qw(Exporter);
    34 our @EXPORT = qw(pb_cms_init pb_cms_export pb_cms_get_uri pb_cms_copy pb_cms_checkout pb_cms_up pb_cms_checkin pb_cms_isdiff pb_cms_get_pkg pb_cms_get_real_pkg pb_cms_compliant pb_cms_log pb_cms_add);
     35our @EXPORT = qw(pb_cms_init pb_cms_checkin pb_cms_get_pkg pb_cms_get_real_pkg pb_cms_compliant pb_cms_log);
    3536($VERSION,$REVISION) = pb_version_init();
    3637
    … …  
    6566pb_log(2,"DEBUG: Project URL of $ENV{'PBPROJ'}: $pburl->{$ENV{'PBPROJ'}}\n");
    6667my ($scheme, $account, $host, $port, $path) = pb_get_uri($pburl->{$ENV{'PBPROJ'}});
    67 my $vcscmd = pb_cms_cmd($scheme);
     68my $vcscmd = pb_vcs_cmd($scheme);
    6869
    6970my ($pbprojdir) = pb_conf_get_if("pbprojdir");
    … …  
    141142}
    142143
    143 =item B<pb_cms_export>
    144 
    145 This function exports a CMS content to a directory.
    146 The first parameter is the URL of the CMS content.
    147 The second parameter is the directory in which it is locally exposed (result of a checkout). If undef, then use the original CMS content.
    148 The third parameter is the directory where we want to deliver it (result of export).
    149 It returns the original tar file if we need to preserve it and undef if we use the produced one.
    150 
    151 =cut
    152 
    153 sub pb_cms_export {
    154 
    155 my $uri = shift;
    156 my $source = shift;
    157 my $destdir = shift;
    158 my $tmp;
    159 my $tmp1;
    160 
    161 pb_log(1,"pb_cms_export uri: $uri - destdir: $destdir\n");
    162 pb_log(1,"pb_cms_export source: $source\n") if (defined $source);
    163 my @date = pb_get_date();
    164 # If it's not flat, then we have a real uri as source
    165 my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri);
    166 my $vcscmd = pb_cms_cmd($scheme);
    167 $uri = pb_cms_mod_socks($uri);
    168 
    169 if ($scheme =~ /^svn/) {
    170     if (defined $source) {
    171         if (-d $source) {
    172             $tmp = $destdir;
    173         } else {
    174             $tmp = "$destdir/".basename($source);
    175         }
    176         $source = pb_cms_mod_htftp($source,"svn");
    177         pb_system("$vcscmd export $source $tmp","Exporting $source from $scheme to $tmp ");
    178     } else {
    179         $uri = pb_cms_mod_htftp($uri,"svn");
    180         pb_system("$vcscmd export $uri $destdir","Exporting $uri from $scheme to $destdir ");
    181     }
    182 } elsif ($scheme eq "svk") {
    183     my $src = $source;
    184     if (defined $source) {
    185         if (-d $source) {
    186             $tmp = $destdir;
    187         } else {
    188             $tmp = "$destdir/".basename($source);
    189             $src = dirname($source);
    190         }
    191         $source = pb_cms_mod_htftp($source,"svk");
    192         # This doesn't exist !
    193         # pb_system("$vcscmd export $path $tmp","Exporting $path from $scheme to $tmp ");
    194         pb_log(4,"$uri,$source,$destdir,$scheme, $account, $host, $port, $path,$tmp");
    195         if (-d $source) {
    196             pb_system("mkdir -p $tmp ; cd $tmp; tar -cf - -C $source . | tar xf -","Exporting $source from $scheme to $tmp ");
    197         } else {
    198             # If source is file do not use -C with source
    199             pb_system("mkdir -p ".dirname($tmp)." ; cd ".dirname($tmp)."; tar -cf - -C $src ".basename($source)." | tar xf -","Exporting $src/".basename($source)." from $scheme to $tmp ");
    200         }
    201     } else {
    202         # Look at svk admin hotcopy
    203         die "Unable to export from svk without a source defined";
    204     }
    205 } elsif ($scheme eq "dir") {
    206     pb_system("cp -r $path $destdir","Copying $uri from DIR to $destdir ");
    207 } elsif (($scheme eq "http") || ($scheme eq "ftp")) {
    208     my $f = basename($path);
    209     unlink "$ENV{'PBTMP'}/$f";
    210     pb_system("$vcscmd $ENV{'PBTMP'}/$f $uri","Downloading $uri with $vcscmd to $ENV{'PBTMP'}/$f\n");
    211     # We want to preserve the original tar file
    212     pb_cms_export("file://$ENV{'PBTMP'}/$f",$source,$destdir);
    213     return("$ENV{'PBTMP'}/$f");
    214 } elsif ($scheme =~ /^file/) {
    215     eval
    216     {
    217         require File::MimeInfo;
    218         File::MimeInfo->import();
    219     };
    220     if ($@) {
    221         # File::MimeInfo not found
    222         die("ERROR: Install File::MimeInfo to handle scheme $scheme\n");
    223     }
    224 
    225     my $mm = mimetype($path);
    226     pb_log(2,"mimetype: $mm\n");
    227 
    228     # Check whether the file is well formed
    229     # (containing already a directory with the project-version name)
    230     #
    231     # If it's not the case, we try to adapt, but distro needing
    232     # to verify the checksum will have issues (Fedora)
    233     # Then upstream should be notified that they need to change their rules
    234     # This doesn't apply to patches or additional sources of course.
    235     my ($pbwf) = pb_conf_get_if("pbwf");
    236     if ((defined $pbwf) && (defined $pbwf->{$ENV{'PBPROJ'}}) && ($path !~ /\/pbpatch\//) && ($path !~ /\/pbsrc\//)) {
    237         $destdir = dirname($destdir);
    238         pb_log(2,"This is a well-formed file so destdir is now $destdir\n");
    239     }
    240     pb_mkdir_p($destdir);
    241 
    242     if ($mm =~ /\/x-bzip-compressed-tar$/) {
    243         # tar+bzip2
    244         pb_system("cd $destdir ; tar xfj $path","Extracting $path in $destdir ");
    245     } elsif ($mm =~ /\/x-lzma-compressed-tar$/) {
    246         # tar+lzma
    247         pb_system("cd $destdir ; tar xfY $path","Extracting $path in $destdir ");
    248     } elsif ($mm =~ /\/x-compressed-tar$/) {
    249         # tar+gzip
    250         pb_system("cd $destdir ; tar xfz $path","Extracting $path in $destdir ");
    251     } elsif ($mm =~ /\/x-tar$/) {
    252         # tar
    253         pb_system("cd $destdir ; tar xf $path","Extracting $path in $destdir ");
    254     } elsif ($mm =~ /\/zip$/) {
    255         # zip
    256         pb_system("cd $destdir ; unzip $path","Extracting $path in $destdir ");
    257     } else {
    258         # simple file: copy it (patch e.g.)
    259         copy($path,$destdir);
    260     }
    261 } elsif ($scheme =~ /^hg/) {
    262     if (defined $source) {
    263         if (-d $source) {
    264             $tmp = $destdir;
    265         } else {
    266             $tmp = "$destdir/".basename($source);
    267         }
    268         $source = pb_cms_mod_htftp($source,"hg");
    269         pb_system("cd $source ; $vcscmd archive $tmp","Exporting $source from Mercurial to $tmp ");
    270     } else {
    271         $uri = pb_cms_mod_htftp($uri,"hg");
    272         pb_system("$vcscmd clone $uri $destdir","Exporting $uri from Mercurial to $destdir ");
    273     }
    274 } elsif ($scheme =~ /^git/) {
    275     if (defined $source) {
    276         if (-d $source) {
    277             $tmp = $destdir;
    278         } else {
    279             $tmp = "$destdir/".basename($source);
    280         }
    281         $source = pb_cms_mod_htftp($source,"git");
    282         pb_system("cd $source ; $vcscmd archive --format=tar HEAD | (mkdir $tmp && cd $tmp && tar xf -)","Exporting $source/HEAD from GIT to $tmp ");
    283     } else {
    284         $uri = pb_cms_mod_htftp($uri,"git");
    285         pb_system("$vcscmd clone $uri $destdir","Exporting $uri from GIT to $destdir ");
    286     }
    287 } elsif ($scheme =~ /^cvs/) {
    288     # CVS needs a relative path !
    289     my $dir=dirname($destdir);
    290     my $base=basename($destdir);
    291     if (defined $source) {
    292         # CVS also needs a modules name not a dir
    293         $tmp1 = basename($source);
    294     } else {
    295         # Probably not right, should be checked, but that way I'll notice it :-)
    296         pb_log(0,"You're in an untested part of project-builder.org, please report any result upstream\n");
    297         $tmp1 = $uri;
    298     }
    299     # If we're working on the CVS itself
    300     my $cvstag = basename($ENV{'PBROOTDIR'});
    301     my $cvsopt = "";
    302     if ($cvstag eq "cvs") {
    303         my $pbdate = strftime("%Y-%m-%d %H:%M:%S", @date);
    304         $cvsopt = "-D \"$pbdate\"";
    305     } else {
    306         # we're working on a tag which should be the last part of PBROOTDIR
    307         $cvsopt = "-r $cvstag";
    308     }
    309     pb_system("cd $dir ; $vcscmd -d $account\@$host:$path export $cvsopt -d $base $tmp1","Exporting $tmp1 from $source under CVS to $destdir ");
    310 } else {
    311     die "cms $scheme unknown";
    312 }
    313 return(undef);
    314 }
    315 
    316 =item B<pb_cms_get_uri>
    317 
    318 This function is only called with a real CMS system and gives the URL stored in the checked out directory.
    319 The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
    320 The second parameter is the directory in which it is locally exposed (result of a checkout).
    321 
    322 =cut
    323 
    324 sub pb_cms_get_uri {
    325 
    326 my $scheme = shift;
    327 my $dir = shift;
    328 
    329 my $res = "";
    330 my $void = "";
    331 my $vcscmd = pb_cms_cmd($scheme);
    332 
    333 if ($scheme =~ /^svn/) {
    334     open(PIPE,"LANGUAGE=C $vcscmd info $dir |") || return("");
    335     while (<PIPE>) {
    336         ($void,$res) = split(/^URL:/) if (/^URL:/);
    337     }
    338     $res =~ s/^\s*//;
    339     close(PIPE);
    340     chomp($res);
    341 } elsif ($scheme =~ /^svk/) {
    342     open(PIPE,"LANGUAGE=C $vcscmd info $dir |") || return("");
    343     my $void2 = "";
    344     while (<PIPE>) {
    345         ($void,$void2,$res) = split(/ /) if (/^Depot/);
    346     }
    347     $res =~ s/^\s*//;
    348     close(PIPE);
    349     chomp($res);
    350 } elsif ($scheme =~ /^hg/) {
    351     open(HGRC,".hg/hgrc/") || return("");
    352     while (<HGRC>) {
    353         ($void,$res) = split(/^default.*=/) if (/^default.*=/);
    354     }
    355     close(HGRC);
    356     chomp($res);
    357 } elsif ($scheme =~ /^git/) {
    358     open(GITRC,".git/gitrc/") || return("");
    359     while (<GITRC>) {
    360         ($void,$res) = split(/^default.*=/) if (/^default.*=/);
    361     }
    362     close(GITRC);
    363     chomp($res);
    364 } elsif ($scheme =~ /^cvs/) {
    365     # This path is always the root path of CVS, but we may be below
    366     open(FILE,"$dir/CVS/Root") || die "$dir isn't CVS controlled";
    367     $res = <FILE>;
    368     chomp($res);
    369     close(FILE);
    370     # Find where we are in the tree
    371     my $rdir = $dir;
    372     while ((! -d "$rdir/CVSROOT") && ($rdir ne "/")) {
    373         $rdir = dirname($rdir);
    374     }
    375     die "Unable to find a CVSROOT dir in the parents of $dir" if (! -d "$rdir/CVSROOT");
    376     #compute our place under that root dir - should be a relative path
    377     $dir =~ s|^$rdir||;
    378     my $suffix = "";
    379     $suffix = "$dir" if ($dir ne "");
    380 
    381     my $prefix = "";
    382     if ($scheme =~ /ssh/) {
    383         $prefix = "cvs+ssh://";
    384     } else {
    385         $prefix = "cvs://";
    386     }
    387     $res = $prefix.$res.$suffix;
    388 } else {
    389     die "cms $scheme unknown";
    390 }
    391 pb_log(1,"pb_cms_get_uri returns $res\n");
    392 return($res);
    393 }
    394 
    395 =item B<pb_cms_copy>
    396 
    397 This function copies a CMS content to another.
    398 The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
    399 The second parameter is the URL of the original CMS content.
    400 The third parameter is the URL of the destination CMS content.
    401 
    402 Only coded for SVN now as used for pbconf itself not the project
    403 
    404 =cut
    405 
    406 sub pb_cms_copy {
    407 my $scheme = shift;
    408 my $oldurl = shift;
    409 my $newurl = shift;
    410 my $vcscmd = pb_cms_cmd($scheme);
    411 $oldurl = pb_cms_mod_socks($oldurl);
    412 $newurl = pb_cms_mod_socks($newurl);
    413 
    414 if ($scheme =~ /^svn/) {
    415     $oldurl = pb_cms_mod_htftp($oldurl,"svn");
    416     $newurl = pb_cms_mod_htftp($newurl,"svn");
    417     pb_system("$vcscmd copy -m \"Creation of $newurl from $oldurl\" $oldurl $newurl","Copying $oldurl to $newurl ");
    418 } elsif (($scheme eq "flat") || ($scheme eq "ftp") || ($scheme eq "http"))   {
    419 } else {
    420     die "cms $scheme unknown for project management";
    421 }
    422 }
    423 
    424 =item B<pb_cms_checkout>
    425 
    426 This function checks a CMS content out to a directory.
    427 The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
    428 The second parameter is the URL of the CMS content.
    429 The third parameter is the directory where we want to deliver it (result of export).
    430 
    431 =cut
    432 
    433 sub pb_cms_checkout {
    434 my $scheme = shift;
    435 my $url = shift;
    436 my $destination = shift;
    437 my $vcscmd = pb_cms_cmd($scheme);
    438 $url = pb_cms_mod_socks($url);
    439 
    440 if ($scheme =~ /^svn/) {
    441     $url = pb_cms_mod_htftp($url,"svn");
    442     pb_system("$vcscmd co $url $destination","Checking out $url to $destination ");
    443 } elsif ($scheme =~ /^svk/) {
    444     $url = pb_cms_mod_htftp($url,"svk");
    445     pb_system("$vcscmd co $url $destination","Checking out $url to $destination ");
    446 } elsif ($scheme =~ /^hg/) {
    447     $url = pb_cms_mod_htftp($url,"hg");
    448     pb_system("$vcscmd clone $url $destination","Checking out $url to $destination ");
    449 } elsif ($scheme =~ /^git/) {
    450     $url = pb_cms_mod_htftp($url,"git");
    451     pb_system("$vcscmd clone $url $destination","Checking out $url to $destination ");
    452 } elsif (($scheme eq "ftp") || ($scheme eq "http")) {
    453     return;
    454 } elsif ($scheme =~ /^cvs/) {
    455     my ($scheme, $account, $host, $port, $path) = pb_get_uri($url);
    456 
    457     # If we're working on the CVS itself
    458     my $cvstag = basename($ENV{'PBROOTDIR'});
    459     my $cvsopt = "";
    460     if ($cvstag eq "cvs") {
    461         my @date = pb_get_date();
    462         my $pbdate = strftime("%Y-%m-%d %H:%M:%S", @date);
    463         $cvsopt = "-D \"$pbdate\"";
    464     } else {
    465         # we're working on a tag which should be the last part of PBROOTDIR
    466         $cvsopt = "-r $cvstag";
    467     }
    468     pb_mkdir_p("$destination");
    469     pb_system("cd $destination ; $vcscmd -d $account\@$host:$path co $cvsopt .","Checking out $url to $destination ");
    470 } elsif ($scheme =~ /^file/) {
    471     pb_cms_export($url,undef,$destination);
    472 } else {
    473     die "cms $scheme unknown";
    474 }
    475 }
    476 
    477 =item B<pb_cms_up>
    478 
    479 This function updates a local directory with the CMS content.
    480 The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
    481 The second parameter is the directory to update.
    482 
    483 =cut
    484 
    485 sub pb_cms_up {
    486 my $scheme = shift;
    487 my $dir = shift;
    488 my $vcscmd = pb_cms_cmd($scheme);
    489 
    490 if (($scheme =~ /^svn/) || ($scheme =~ /^cvs/) || ($scheme =~ /^svk/)) {
    491     pb_system("$vcscmd up $dir","Updating $dir ");
    492 } elsif (($scheme eq "flat") || ($scheme eq "ftp") || ($scheme eq "http"))   {
    493 } else {
    494     die "cms $scheme unknown";
    495 }
    496 }
    497 
    498144=item B<pb_cms_checkin>
    499145
    … …  
    509155my $dir = shift;
    510156my $pbinit = shift || undef;
    511 my $vcscmd = pb_cms_cmd($scheme);
    512157
    513158my $ver = basename($dir);
    … …  
    515160$msg = "Project $ENV{PBPROJ} creation" if (defined $pbinit);
    516161
    517 if (($scheme =~ /^svn/) || ($scheme =~ /^cvs/) || ($scheme =~ /^svk/)) {
    518     pb_system("cd $dir ; $vcscmd ci -m \"$msg\" .","Checking in $dir ");
    519 } elsif (($scheme eq "flat") || ($scheme eq "ftp") || ($scheme eq "http"))   {
    520 } else {
    521     die "cms $scheme unknown";
    522 }
    523 pb_cms_up($scheme,$dir);
    524 }
    525 
    526 =item B<pb_cms_add>
    527 
    528 This function adds to a CMS content from a local directory.
    529 The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
    530 The second parameter is the directory/file to add.
    531 
    532 =cut
    533 
    534 sub pb_cms_add {
    535 my $scheme = shift;
    536 my $f = shift;
    537 my $vcscmd = pb_cms_cmd($scheme);
    538 
    539 if (($scheme =~ /^svn/) || ($scheme =~ /^cvs/) || ($scheme =~ /^svk/)) {
    540     pb_system("$vcscmd add $f","Adding $f to VCS ");
    541 } elsif (($scheme eq "flat") || ($scheme eq "ftp") || ($scheme eq "http"))   {
    542 } else {
    543     die "cms $scheme unknown";
    544 }
    545 pb_cms_up($scheme,$f);
    546 }
    547 
    548 =item B<pb_cms_isdiff>
    549 
    550 This function returns a integer indicating the number f differences between the CMS content and the local directory where it's checked out.
    551 The first parameter is the schema of the CMS systems (svn, cvs, svn+ssh, ...)
    552 The second parameter is the directory to consider.
    553 
    554 =cut
    555 
    556 sub pb_cms_isdiff {
    557 my $scheme = shift;
    558 my $dir =shift;
    559 my $vcscmd = pb_cms_cmd($scheme);
    560 my $l = undef;
    561 
    562 if (($scheme =~ /^svn/) || ($scheme =~ /^cvs/) || ($scheme =~ /^svk/)) {
    563     open(PIPE,"$vcscmd diff $dir |") || die "Unable to get $vcscmd diff from $dir";
    564     $l = 0;
    565     while (<PIPE>) {
    566         # Skipping normal messages in case of CVS
    567         next if (/^cvs diff:/);
    568         $l++;
    569     }
    570 } elsif (($scheme eq "flat") || ($scheme eq "ftp") || ($scheme eq "http"))   {
    571     $l = 0;
    572 } else {
    573     die "cms $scheme unknown";
    574 }
    575 pb_log(1,"pb_cms_isdiff returns $l\n");
    576 return($l);
     162pb_vcs_checkin($scheme,$dir,$msg);
    577163}
    578164
    … …  
    707293    pb_mkdir_p("$ENV{$envar}");
    708294    pb_rm_rf($ENV{$envar});
    709     pb_cms_checkout($scheme,$uri,$ENV{$envar});
     295    pb_vcs_checkout($scheme,$uri,$ENV{$envar});
    710296} else {
    711297    pb_log(1,"$uri found locally, checking content\n");
    712     my $cmsurl = pb_cms_get_uri($scheme,$ENV{$envar});
     298    my $cmsurl = pb_vcs_get_uri($scheme,$ENV{$envar});
    713299    my ($scheme2, $account2, $host2, $port2, $path2) = pb_get_uri($cmsurl);
    714300    # For svk, scheme doesn't appear in svk info so remove it here in uri coming from conf file
    … …  
    800386
    801387pb_cms_create_authors($authors,$dest,$scheme);
    802 my $vcscmd = pb_cms_cmd($scheme);
     388my $vcscmd = pb_vcs_cmd($scheme);
    803389
    804390if ((defined $testver) && (defined $testver->{$ENV{'PBPROJ'}}) && ($testver->{$ENV{'PBPROJ'}} =~ /true/i)) {
    … …  
    869455}
    870456
    871 sub pb_cms_mod_htftp {
    872 
    873 my $url = shift;
    874 my $proto = shift;
    875 
    876 $url =~ s/^$proto\+((ht|f)tp[s]*):/$1:/;
    877 pb_log(1,"pb_cms_mod_htftp returns $url\n");
    878 return($url);
    879 }
    880 
    881 sub pb_cms_mod_socks {
    882 
    883 my $url = shift;
    884 
    885 $url =~ s/^([A-z0-9]+)\+(socks):/$1:/;
    886 pb_log(1,"pb_cms_mod_socks returns $url\n");
    887 return($url);
    888 }
    889 
    890 
    891 sub pb_cms_cmd {
    892 
    893 my $scheme = shift;
    894 my $cmd = "";
    895 
    896 # If there is a socks proxy to use
    897 if ($scheme =~ /socks/) {
    898     # Get the socks proxy command from the conf file
    899     my ($pbsockscmd) = pb_conf_get("pbsockscmd");
    900     $cmd = "$pbsockscmd->{$ENV{'PBPROJ'}} ";
    901 }
    902 
    903 if ($scheme =~ /hg/) {
    904     return($cmd."hg")
    905 } elsif ($scheme =~ /git/) {
    906     return($cmd."git")
    907 } elsif ($scheme =~ /svn/) {
    908     return($cmd."svn")
    909 } elsif ($scheme =~ /svk/) {
    910     return($cmd."svk")
    911 } elsif ($scheme =~ /cvs/) {
    912     return($cmd."cvs")
    913 } elsif (($scheme =~ /http/) || ($scheme =~ /ftp/)) {
    914     my $command = pb_check_req("wget",1);
    915     if (-x $command) {
    916         return($cmd."$command -nv -O ");
    917     } else {
    918         $command = pb_check_req("curl",1);
    919         if (-x $command) {
    920             return($cmd."$command -o ");
    921         } else {
    922             die "Unable to handle $scheme.\nNo wget/curl available, please install one of those";
    923         }
    924     }
    925 } else {
    926     return($cmd);
    927 }
    928 }
    929 
    930    
    931 
    932457=back
    933458
Note: See TracChangeset for help on using the changeset viewer.