Changeset 331 in ProjectBuilder for devel/pb/lib
- Timestamp:
- Mar 2, 2008, 12:25:28 AM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
devel/pb/lib/ProjectBuilder/Base.pm
r328 r331 32 32 33 33 our @ISA = qw(Exporter); 34 our @EXPORT = qw(pb_env_init pb_conf_read pb_conf_read_if pb_conf_get pb_conf_get_if pb_cms_init pb_mkdir_p pb_system pb_rm_rf pb_get_filters pb_filter_file pb_filter_file_pb pb_filter_file_inplace pb_cms_export pb_cms_log pb_cms_isdiff pb_cms_copy pb_cms_checkout pb_get_date pb_log pb_log_init pb_get_pkg pb_cms_compliant $debug $LOG);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 pb_get_uri pb_cms_get_uri $debug $LOG); 35 35 36 36 $ENV{'PBETC'} = "$ENV{'HOME'}/.pbrc"; … … 87 87 # Tree will look like this: 88 88 # 89 # maint pbdefdir PBDEFDIR dev dir (optional) PBDEVDIR89 # maint pbdefdir PBDEFDIR dev dir (optional) 90 90 # | | 91 91 # ------------------------ -------------------- 92 92 # | | | | 93 # pbproj1 pbproj2 PBPROJ pbproj1 pbproj2 PBDEVPROJ93 # pbproj1 pbproj2 PBPROJ pbproj1 pbproj2 94 94 # | | 95 95 # --------------------------------------------- ---------- 96 96 # * * * | | | * * 97 # tag dev pbconf ... build delivery PBCONF dev tag PBDEVROOT97 # tag dev pbconf ... build delivery PBCONF dev tag 98 98 # | | | PBDESTDIR | 99 99 # --- ------ pbrc PBBUILDDIR ------- 100 100 # | | | | | 101 # 1.1 dev tag PBROOT 1.0 1.1 101 # 1.1 dev tag PBROOT 1.0 1.1 PBDIR 102 102 # | 103 103 # ------- … … 989 989 sub pb_cms_init { 990 990 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'}}); 991 my $scheme = shift || undef; 998 992 999 993 if ($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; 1002 998 $ENV{'PBCMSLOGFILE'}="svn.log"; 1003 999 } elsif (($scheme eq "file") || ($scheme eq "ftp") || ($scheme eq "http")) { 1004 1000 $ENV{'PBREVISION'}="flat"; 1005 1001 $ENV{'PBCMSLOGFILE'}="flat.log"; 1006 } elsif ($scheme eq "cvs") {1002 } elsif ($scheme =~ /^cvs/) { 1007 1003 # Way too slow 1008 1004 #$ENV{'PBREVISION'}=`(cd "$ENV{'PBROOT'}" ; cvs rannotate -f . 2>&1 | awk '{print \$1}' | grep -E '^[0-9]' | cut -d. -f2 |sort -nu | tail -1)`; 1009 1005 #chomp($ENV{'PBREVISION'}); 1010 $ENV{'PBREVISION'}=" CVS";1006 $ENV{'PBREVISION'}="cvs"; 1011 1007 $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/); 1017 1009 } else { 1018 1010 die "cms $scheme unknown"; 1019 1011 } 1020 1021 return($scheme,$uri->{$ENV{'PBPROJ'}});1022 1012 } 1023 1013 … … 1099 1089 pb_rm_rf("$destdir/$d0"); 1100 1090 } 1101 } elsif ($scheme eq "cvs") { 1091 } elsif ($scheme =~ /^cvs/) { 1092 # CVS needs a relative path ! 1102 1093 my $dir=dirname($destdir); 1103 1094 my $base=basename($destdir); 1095 # CVS also needs a modules name not a dir 1104 1096 if (-d $source) { 1105 1097 $tmp1 = $source; 1106 1098 $tmp1 =~ s|$ENV{'PBROOT'}/||; 1099 $tmp1 =~ s|$ENV{'PBDIR'}/||; 1107 1100 } else { 1108 1101 $tmp1 = dirname($source); 1109 1102 $tmp1 =~ s|$ENV{'PBROOT'}/||; 1103 $tmp1 =~ s|$ENV{'PBDIR'}/||; 1110 1104 $tmp1 = $tmp1."/".basename($source); 1111 1105 } 1112 # CVS needs a relative path !1113 my ($cvsroot) = pb_conf_get("cvsroot");1114 1106 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"); 1116 1108 } else { 1117 1109 die "cms $scheme unknown"; … … 1168 1160 if (! -f "$dest/ChangeLog") { 1169 1161 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); 1170 1165 pb_system("/usr/bin/svn2cl --group-by-day --authors=$authors -i -o $dest/ChangeLog $pkgdir","Generating ChangeLog from SVN with svn2cl"); 1171 1166 } else { … … 1178 1173 pb_system("echo ChangeLog for $pkgdir > $dest/ChangeLog","Empty ChangeLog file created"); 1179 1174 } 1180 } elsif ($scheme eq "cvs") {1175 } elsif ($scheme =~ /^cvs/) { 1181 1176 my $tmp=basename($pkgdir); 1182 1177 # CVS needs a relative path ! 1183 1178 if (! -f "$dest/ChangeLog") { 1184 1179 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); 1185 1183 pb_system("/usr/bin/cvs2cl --group-by-day -U $authors -f $dest/ChangeLog $pkgdir","Generating ChangeLog from CVS with cvs2cl"); 1186 1184 } else { … … 1194 1192 } 1195 1193 1196 sub pb_cms_get info{1194 sub pb_cms_get_uri { 1197 1195 1198 1196 my $scheme = shift; 1199 1197 my $dir = shift; 1200 my $info = shift || "URL:";1201 1198 1202 1199 my $res = ""; … … 1206 1203 open(PIPE,"LANGUAGE=C svn info $dir |") || return(""); 1207 1204 while (<PIPE>) { 1208 ($void,$res) = split(/^ $info/) if (/^$info/);1205 ($void,$res) = split(/^URL:/) if (/^URL:/); 1209 1206 } 1210 1207 $res =~ s/^\s*//; … … 1212 1209 chomp($res); 1213 1210 } 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; 1215 1236 } else { 1216 1237 die "cms $scheme unknown"; … … 1225 1246 my $newurl = shift; 1226 1247 1227 if ($scheme eq "svn") {1248 if ($scheme =~ /^svn/) { 1228 1249 pb_system("svn copy -m \"Creation of $newurl from $oldurl\" $oldurl $newurl","Copying $oldurl to $newurl "); 1229 1250 } elsif ($scheme eq "flat") { 1230 } elsif ($scheme eq "cvs") {1251 } elsif ($scheme =~ /^cvs/) { 1231 1252 } else { 1232 1253 die "cms $scheme unknown"; … … 1242 1263 pb_system("svn co $url $destination","Checking out $url to $destination "); 1243 1264 } elsif ($scheme eq "flat") { 1244 } elsif ($scheme eq "cvs") {1265 } elsif ($scheme =~ /^cvs/) { 1245 1266 } else { 1246 1267 die "cms $scheme unknown"; … … 1253 1274 1254 1275 my $ver = basename($dir); 1255 if ($scheme eq "svn") {1276 if ($scheme =~ /^svn/) { 1256 1277 pb_system("svn ci -m \"Updated to $ver\" $dir","Checking in $dir"); 1257 1278 pb_system("svn up $dir","Updating $dir"); 1258 1279 } elsif ($scheme eq "flat") { 1259 } elsif ($scheme eq "cvs") {1280 } elsif ($scheme =~ /^cvs/) { 1260 1281 } else { 1261 1282 die "cms $scheme unknown"; … … 1266 1287 my $scheme = shift; 1267 1288 1268 if ($scheme eq "svn") {1289 if ($scheme =~ /^svn/) { 1269 1290 open(PIPE,"svn diff $ENV{'PBROOT'} |") || die "Unable to get svn diff from $ENV{'PBROOT'}"; 1270 1291 my $l = 0; … … 1274 1295 return($l); 1275 1296 } elsif ($scheme eq "flat") { 1276 } elsif ($scheme eq "cvs") {1297 } elsif ($scheme =~ /^cvs/) { 1277 1298 } else { 1278 1299 die "cms $scheme unknown"; … … 1529 1550 } else { 1530 1551 pb_log(1,"$uri found locally, checking content\n"); 1531 my $cmsurl = pb_cms_get info($scheme,$ENV{$envar},"URL:");1552 my $cmsurl = pb_cms_get_uri($scheme,$ENV{$envar}); 1532 1553 my ($scheme2, $account2, $host2, $port2, $path2) = pb_get_uri($cmsurl); 1533 1554 if ($cmsurl ne $uri) {
Note:
See TracChangeset
for help on using the changeset viewer.