Changeset 315 in ProjectBuilder for devel/pb/lib/ProjectBuilder/Base.pm
- Timestamp:
- Feb 10, 2008, 6:40:37 AM (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
devel/pb/lib/ProjectBuilder/Base.pm
r314 r315 10 10 use File::Basename; 11 11 use File::Path; 12 use File::Copy; 12 13 use File::Temp qw /tempdir/; 13 14 use Data::Dumper; 15 use POSIX qw(strftime); 14 16 15 17 use ProjectBuilder::Changelog qw (pb_changelog); 16 18 17 19 $ENV{'PBETC'} = "$ENV{'HOME'}/.pbrc"; 20 21 my $debug = 0; 22 my $LOG = \*STDOUT; 18 23 19 24 sub pb_env_init { … … 24 29 my $tag; 25 30 26 # For the moment not dynamic27 my $debug = 0; # Debug level28 my $LOG = *STDOUT; # Where to log29 30 31 # 31 32 # Check project name … … 44 45 # 45 46 my ($pbconf) = pb_conf_read("$ENV{'PBETC'}","pbconf"); 46 p rint "DEBUG pbconf: ".Dumper($pbconf)."\n" if ($debug >= 1);47 pb_log(2,"DEBUG pbconf: ".Dumper($pbconf)."\n"); 47 48 48 49 my %pbconf = %$pbconf; … … 50 51 # Take the first as the default project 51 52 $proj = (keys %pbconf)[0]; 52 if ( ($debug >= 0) and (defined $proj)) {53 p rint $LOG "WARNING: using $proj as default project as none has been specified\n"54 p rint $LOG "Please create a pbconf reference for project $proj in $ENV{'PBETC'}\nif you want to use another project\n";53 if (defined $proj) { 54 pb_log(2,"WARNING: using $proj as default project as none has been specified\n"); 55 pb_log(2,"Please create a pbconf reference for project $proj in $ENV{'PBETC'}\nif you want to use another project\n"); 55 56 } 56 57 } … … 69 70 # Tree will look like this: 70 71 # 71 # maint pbdir dev dir (optional)72 # | |73 # ------------------------ --------------------74 # | | | |75 # pbproj1 pbproj2 pbproj1 pbproj276 # | |77 # --------------------------------------------- ----------78 # * * | | | | * *79 # 1.0 dev pbconf ... build delivery 1.0 dev80 # | | |81 # ------ pbrc 72 # maint pbdir PBDIR dev dir (optional) PBDEVDIR 73 # | | 74 # ------------------------ -------------------- 75 # | | | | 76 # pbproj1 pbproj2 PBPROJ pbproj1 pbproj2 PBDEVPROJ 77 # | | 78 # --------------------------------------------- ---------- 79 # * * | | | | * * 80 # 1.0 dev pbconf ... build delivery PBCONF 1.0 dev PBDEVROOT 81 # | | PBDESTDIR 82 # ------ pbrc PBBUILDDIR 82 83 # | | 83 # 1.0 dev 84 # 1.0 dev PBROOT 84 85 # | 85 86 # ---------------------------------- … … 101 102 if (not defined $ENV{'PBDIR'}) { 102 103 if (not defined ($pbdir{$ENV{'PBPROJ'}})) { 103 p rint $LOG "WARNING: no pbdir defined, using /var/cache\n";104 p rint $LOG "Please create a pbdir reference for project $ENV{'PBPROJ'} in $ENV{'PBETC'}\nif you want to use another directory\n";104 pb_log(2,"WARNING: no pbdir defined, using /var/cache\n"); 105 pb_log(2,"Please create a pbdir reference for project $ENV{'PBPROJ'} in $ENV{'PBETC'}\nif you want to use another directory\n"); 105 106 } 106 107 # That's always the environment variable that will be used … … 157 158 158 159 my ($scheme, $account, $host, $port, $path) = pb_get_uri($pbconf{$ENV{'PBPROJ'}}); 159 my $cms = { $ENV{'PBPROJ'} => $scheme };160 160 161 161 if ((not -d "$ENV{'PBCONF'}") || (defined $pbinit)) { 162 pb_cms_checkout($ cms,$pbconf{$ENV{'PBPROJ'}},$ENV{'PBCONF'});162 pb_cms_checkout($scheme,$pbconf{$ENV{'PBPROJ'}},$ENV{'PBCONF'}); 163 163 } else { 164 my $cmsurl = pb_cms_getinfo($ cms,$ENV{'PBCONF'});164 my $cmsurl = pb_cms_getinfo($scheme,$ENV{'PBCONF'},"URL:"); 165 165 if ($cmsurl !~ /^$scheme/) { 166 166 pb_rm_rf("$ENV{'PBCONF'}"); 167 pb_cms_checkout($ cms,$pbconf{$ENV{'PBPROJ'}},$ENV{'PBCONF'});167 pb_cms_checkout($scheme,$pbconf{$ENV{'PBPROJ'}},$ENV{'PBCONF'}); 168 168 } elsif ($cmsurl ne $pbconf{$ENV{'PBPROJ'}}) { 169 169 # The local content doesn't correpond to the repository 170 p rint $LOG "ERROR: Inconsistency detected:\n";171 p rint $LOG "* $ENV{'PBCONF'} refers to $cmsurl but\n";172 p rint $LOG "* $ENV{'PBETC'} refers to $pbconf{$ENV{'PBPROJ'}}\n";170 pb_log(2,"ERROR: Inconsistency detected:\n"); 171 pb_log(2,"* $ENV{'PBCONF'} refers to $cmsurl but\n"); 172 pb_log(2,"* $ENV{'PBETC'} refers to $pbconf{$ENV{'PBPROJ'}}\n"); 173 173 die "Project $ENV{'PBPROJ'} is not Project-Builder compliant."; 174 174 } else { … … 181 181 if (! -f ("$ENV{'PBDESTDIR'}/pbrc")) { 182 182 opendir(DIR,$ENV{'PBCONF'}) || die "Unable to open directory $ENV{'PBCONF'}: $!"; 183 my maxmtime = 0;183 my $maxmtime = 0; 184 184 foreach my $d (readdir(DIR)) { 185 185 next if ($d =~ /^\./); … … 194 194 } 195 195 closedir(DIR); 196 p rint $LOG "WARNING: no pbroot defined, using $ENV{'PBROOT'}\n";197 p rint $LOG "Please -r release if you want to use another release\n";196 pb_log(2,"WARNING: no pbroot defined, using $ENV{'PBROOT'}\n"); 197 pb_log(2,"Please -r release if you want to use another release\n"); 198 198 } else { 199 199 my ($pbroot) = pb_conf_read_if("$ENV{'PBDESTDIR'}/pbrc","pbroot"); 200 200 # That's always the environment variable that will be used 201 $ENV{'PBROOT'} = $pbroot {$ENV{'PBPROJ'}};201 $ENV{'PBROOT'} = $pbroot->{$ENV{'PBPROJ'}}; 202 202 } 203 203 } else { 204 204 # transform in full path if relative 205 $ENV{'PBROOT'} = "$ENV{'PBCONF'}/$ENV{'PBROOT'}" if ($ENV{'PBROOT'} !~ |/|);205 $ENV{'PBROOT'} = "$ENV{'PBCONF'}/$ENV{'PBROOT'}" if ($ENV{'PBROOT'} !~ /\//); 206 206 } 207 207 … … 220 220 # Project version and tag (optional) 221 221 my ($extpkgdir, $version, $filteredfiles, $supfiles, $pkgv, $pkgt) = pb_conf_get_if("extpkgdir","version","filteredfiles","supfiles","projver","projtag"); 222 p rint "DEBUG: defpkgdir: ".Dumper($defpkgdir)."\n" if ($debug >= 1);223 p rint "DEBUG: extpkgdir: ".Dumper($extpkgdir)."\n" if ($debug >= 1);224 p rint "DEBUG: version: ".Dumper($version)."\n" if ($debug >= 1);225 p rint "DEBUG: filteredfiles: ".Dumper($filteredfiles)."\n" if ($debug >= 1);226 p rint "DEBUG: supfiles: ".Dumper($supfiles)."\n" if ($debug >= 1);222 pb_log(2,"DEBUG: defpkgdir: ".Dumper($defpkgdir)."\n"); 223 pb_log(2,"DEBUG: extpkgdir: ".Dumper($extpkgdir)."\n"); 224 pb_log(2,"DEBUG: version: ".Dumper($version)."\n"); 225 pb_log(2,"DEBUG: filteredfiles: ".Dumper($filteredfiles)."\n"); 226 pb_log(2,"DEBUG: supfiles: ".Dumper($supfiles)."\n"); 227 227 # Global 228 228 %defpkgdir = %$defpkgdir; … … 718 718 pb_mkdir_p("$ENV{'PBROOT'}/pkg1/pbfilter") || die "Unable to create $ENV{'PBROOT'}/pkg1/pbfilter"; 719 719 720 p rint "\nDo not to forget to commit the pbconf directory in your CMS if needed\n";721 p rint "After having renamed the pkg1 directory to your package's name \n\n";720 pb_log(2,"\nDo not to forget to commit the pbconf directory in your CMS if needed\n"); 721 pb_log(2,"After having renamed the pkg1 directory to your package's name \n\n"); 722 722 } else { 723 723 die "Unable to open $ENV{'PBROOT'}/$ENV{'PBPROJ'}.pb"; … … 725 725 } 726 726 umask 0022; 727 return( $debug,$LOG,\%filteredfiles, \%supfiles, \%defpkgdir, \%extpkgdir);727 return(\%filteredfiles, \%supfiles, \%defpkgdir, \%extpkgdir); 728 728 } 729 729 … … 748 748 my $cmt=shift || $cmd; 749 749 750 p rint "$cmt... ";750 pb_log(2,"$cmt... "); 751 751 #system("$cmd 2>&1 > $ENV{'PBTMP'}/system.log"); 752 752 system($cmd); 753 753 if ($? == -1) { 754 p rint "failed to execute ($cmd) : $!\n";754 pb_log(2,"failed to execute ($cmd) : $!\n"); 755 755 pb_display_file("$ENV{'PBTMP'}/system.log"); 756 756 } elsif ($? & 127) { 757 p rintf "child ($cmd) died with signal %d, %s coredump\n", ($? & 127), ($? & 128) ? 'with' : 'without';757 pb_log(2, "child ($cmd) died with signal ".($? & 127).", ".($? & 128) ? 'with' : 'without'." coredump\n"); 758 758 pb_display_file("$ENV{'PBTMP'}/system.log"); 759 759 } elsif ($? == 0) { 760 p rint "OK\n";760 pb_log(2,"OK\n"); 761 761 } else { 762 p rintf "child ($cmd) exited with value %d\n", $? >> 8;762 pb_log(2, "child ($cmd) exited with value ".($? >> 8)."\n"); 763 763 pb_display_file("$ENV{'PBTMP'}/system.log"); 764 764 } … … 785 785 my @return = pb_conf_get_if(@param); 786 786 787 die "No params found for $ENV{'PBPROJ'}" if (not defined@return);787 die "No params found for $ENV{'PBPROJ'}" if (not @return); 788 788 789 789 foreach my $i (0..$#param) { … … 807 807 my $p2; 808 808 809 #print "DEBUG: param1: ".Dumper(@ptr1)."\n"; # if ($debug >= 1);810 #print "DEBUG: param2: ".Dumper(@ptr2)."\n"; # if ($debug >= 1);809 pb_log(2,"DEBUG: param1: ".Dumper(@ptr1)."\n"); 810 pb_log(2,"DEBUG: param2: ".Dumper(@ptr2)."\n"); 811 811 812 812 foreach my $i (0..$#param) { … … 842 842 } 843 843 $ptr1[$i] = $p1; 844 #print "DEBUG: param ptr1: ".Dumper(@ptr1)."\n"; # if ($debug >= 1);844 pb_log(2,"DEBUG: param ptr1: ".Dumper(@ptr1)."\n"); 845 845 } 846 846 return(@ptr1); … … 870 870 my %h; 871 871 872 my $debug = 0;873 874 872 open(CONF,$conffile) || die "Unable to open $conffile"; 875 873 while(<CONF>) { 876 874 if (/^\s*([A-z0-9-_]+)\s+([[A-z0-9-_]+)\s*=\s*(.+)$/) { 877 p rint "DEBUG: 1:$1 2:$2 3:$3\n" if ($debug >= 1);875 pb_log(2,"DEBUG: 1:$1 2:$2 3:$3\n"); 878 876 $h{$1}{$2}=$3; 879 877 } … … 884 882 push @ptr,$h{$param}; 885 883 } 886 p rint "DEBUG: h:".Dumper(%h)." param:".Dumper(@param)." ptr:".Dumper(@ptr)."\n" if ($debug >= 1);884 pb_log(2,"DEBUG: h:".Dumper(%h)." param:".Dumper(@param)." ptr:".Dumper(@ptr)."\n"); 887 885 return(@ptr); 888 886 } … … 898 896 $uri =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 899 897 my ($account,$host,$port) = $authority =~ m|(?:([^\@]+)\@)?([^:]+)(:(?:[0-9]+))?|; 900 p rint "DEBUG: scheme:$scheme ac:$account host:$host port:$port path:$path\n" if ($debug >= 1);898 pb_log(2,"DEBUG: scheme:$scheme ac:$account host:$host port:$port path:$path\n"); 901 899 return($scheme, $account, $host, $port, $path); 902 900 } … … 907 905 908 906 my $proj = shift || undef; 909 my $ret; 910 911 my ($cms) = pb_conf_get("cms"); 912 913 if ($cms->{$proj} eq "svn") { 914 $ENV{'PBREVISION'}=`(cd "$ENV{'PBROOT'}" ; svnversion .)`; 915 chomp($ENV{'PBREVISION'}); 907 908 # Use the project URI 909 my ($uri) = pb_conf_get("pburl"); 910 911 # Extract values from that URI 912 my ($scheme, $account, $host, $port, $path) = pb_get_uri($uri->{$ENV{'PBPROJ'}}); 913 914 if ($scheme =~ /^svn/) { 915 $ENV{'PBREVISION'}= pb_cms_getinfo($scheme,$uri->{$ENV{'PBPROJ'}},"Revision:"); 916 #$ENV{'PBREVISION'}=`(cd "$ENV{'PBDEVDIR'}" ; svnversion .)`; 916 917 $ENV{'PBCMSLOGFILE'}="svn.log"; 917 } elsif ( $cms->{$proj} eq "flat") {918 } elsif (($scheme eq "file") || ($scheme eq "ftp") || ($scheme eq "http")) { 918 919 $ENV{'PBREVISION'}="flat"; 919 920 $ENV{'PBCMSLOGFILE'}="flat.log"; 920 } elsif ($ cms->{$proj}eq "cvs") {921 } elsif ($scheme eq "cvs") { 921 922 # Way too slow 922 923 #$ENV{'PBREVISION'}=`(cd "$ENV{'PBROOT'}" ; cvs rannotate -f . 2>&1 | awk '{print \$1}' | grep -E '^[0-9]' | cut -d. -f2 |sort -nu | tail -1)`; … … 930 931 $ENV{'CVS_RSH'} = $cvsrsh->{$proj} if (defined $cvsrsh->{$proj}); 931 932 } else { 932 die "cms $cms->{$proj} unknown"; 933 } 934 return($cms); 933 die "cms $scheme unknown"; 934 } 935 936 # 937 #if (not defined $scheme) { 938 # We're an upstream guy 939 # Try to make it easy for us 940 #pb_log(2,"WARNING: Assuming a local project under $ENV{'PBDIR'}/$ENV{'PBPROJ'}:\n"); 941 #pb_log(2,"If not, pleaase setup a pbproj entry in $ENV{'PBROOT'}/$ENV{'PBPROJ'}.pb\n"); 942 #return(""); 943 #} 944 945 return($scheme,$uri->{$ENV{'PBPROJ'}}); 946 } 947 948 sub pb_get_date { 949 950 return(localtime->sec(), localtime->min(), localtime->hour(), localtime->mday(), localtime->mon(), localtime->year(), localtime->wday(), localtime->yday(), localtime->isdst()); 935 951 } 936 952 937 953 sub pb_cms_export { 938 my $cms = shift; 939 my $ pbdate = shift || undef;954 955 my $scheme = shift; 940 956 my $source = shift; 941 957 my $destdir = shift; … … 943 959 my $tmp1; 944 960 945 if ($cms->{$ENV{'PBPROJ'}} eq "svn") { 961 my @date = pb_get_date(); 962 963 if ($scheme eq "svn") { 946 964 if (-d $source) { 947 965 $tmp = $destdir; … … 950 968 } 951 969 pb_system("svn export $source $tmp","Exporting $source from SVN to $tmp"); 952 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "flat") {970 } elsif ($scheme eq "flat") { 953 971 if (-d $source) { 954 972 $tmp = $destdir; … … 957 975 } 958 976 pb_system("cp -a $source $tmp","Exporting $source from DIR to $tmp"); 959 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "cvs") {977 } elsif ($scheme eq "cvs") { 960 978 my $dir=dirname($destdir); 961 979 my $base=basename($destdir); … … 970 988 # CVS needs a relative path ! 971 989 my ($cvsroot) = pb_conf_get("cvsroot"); 990 my $pbdate = strftime("%Y-%m-%d %H:%M:%S", @date); 972 991 pb_system("cd $dir ; cvs -d $cvsroot->{$ENV{'PBPROJ'}} export -D \"$pbdate\" -d $base $tmp1","Exporting $source from CVS to $destdir"); 973 992 } else { 974 die "cms $ cms->{$ENV{'PBPROJ'}}unknown";993 die "cms $scheme unknown"; 975 994 } 976 995 } … … 981 1000 my $authors=shift; 982 1001 my $dest=shift; 983 my $ cms=shift;1002 my $scheme=shift; 984 1003 985 1004 return if ($authors eq "/dev/null"); … … 992 1011 chomp($gcos); 993 1012 print DAUTH "$gcos"; 994 if (defined $ cms) {995 print DAUTH " ($nick under $ cms)\n";1013 if (defined $scheme) { 1014 print DAUTH " ($nick under $scheme)\n"; 996 1015 } else { 997 1016 print DAUTH "\n"; … … 1003 1022 1004 1023 sub pb_cms_log { 1005 my $ cms= shift;1024 my $scheme = shift; 1006 1025 my $pkgdir = shift; 1007 1026 my $dest = shift; … … 1009 1028 my $authors = shift; 1010 1029 1011 pb_create_authors($authors,$dest,$ cms->{$ENV{'PBPROJ'}});1012 1013 if ($ cms->{$ENV{'PBPROJ'}}eq "svn") {1030 pb_create_authors($authors,$dest,$scheme); 1031 1032 if ($scheme eq "svn") { 1014 1033 if (! -f "$dest/ChangeLog") { 1015 1034 if (-x "/usr/bin/svn2cl") { 1016 pb_system("/usr/bin/svn2cl --group-by-day --authors=$authors -i -o $dest/ChangeLog $pkgdir","Generating ChangeLog from SVN ");1035 pb_system("/usr/bin/svn2cl --group-by-day --authors=$authors -i -o $dest/ChangeLog $pkgdir","Generating ChangeLog from SVN with svn2cl"); 1017 1036 } else { 1018 1037 # To be written from pbcl … … 1020 1039 } 1021 1040 } 1022 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "flat") {1041 } elsif ($scheme eq "flat") { 1023 1042 if (! -f "$dest/ChangeLog") { 1024 1043 pb_system("echo ChangeLog for $pkgdir > $dest/ChangeLog","Empty ChangeLog file created"); 1025 1044 } 1026 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "cvs") {1045 } elsif ($scheme eq "cvs") { 1027 1046 my $tmp=basename($pkgdir); 1028 1047 # CVS needs a relative path ! 1029 1048 if (! -f "$dest/ChangeLog") { 1030 1049 if (-x "/usr/bin/cvs2cl") { 1031 pb_system("/usr/bin/cvs2cl --group-by-day -U $authors -f $dest/ChangeLog $pkgdir","Generating ChangeLog from CVS ");1050 pb_system("/usr/bin/cvs2cl --group-by-day -U $authors -f $dest/ChangeLog $pkgdir","Generating ChangeLog from CVS with cvs2cl"); 1032 1051 } else { 1033 1052 # To be written from pbcl … … 1036 1055 } 1037 1056 } else { 1038 die "cms $ cms->{$ENV{'PBPROJ'}}unknown";1057 die "cms $scheme unknown"; 1039 1058 } 1040 1059 } 1041 1060 1042 1061 sub pb_cms_getinfo { 1043 my $ cms= shift;1062 my $scheme = shift; 1044 1063 my $dir = shift; 1045 my $url = ""; 1064 my $info = shift || "URL:"; 1065 1066 my $res = ""; 1046 1067 my $void = ""; 1047 1068 1048 if ($ cms->{$ENV{'PBPROJ'}}=~ /^svn/) {1069 if ($scheme =~ /^svn/) { 1049 1070 open(PIPE,"LANGUAGE=C svn info $dir |") || return(""); 1050 1071 while (<PIPE>) { 1051 ($void,$ url) = split(/^URL:/) if (/^URL:/);1072 ($void,$res) = split(/^$info/) if (/^$info/); 1052 1073 } 1053 1074 close(PIPE); 1054 chomp($ url);1055 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "flat") {1056 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "cvs") {1075 chomp($res); 1076 } elsif ($scheme eq "flat") { 1077 } elsif ($scheme eq "cvs") { 1057 1078 } else { 1058 die "cms $ cms->{$ENV{'PBPROJ'}}unknown";1059 } 1060 return($ url);1079 die "cms $scheme unknown"; 1080 } 1081 return($res); 1061 1082 } 1062 1083 1063 1084 sub pb_cms_copy { 1064 my $ cms= shift;1085 my $scheme = shift; 1065 1086 my $oldurl = shift; 1066 1087 my $newurl = shift; 1067 1088 1068 if ($ cms->{$ENV{'PBPROJ'}}eq "svn") {1089 if ($scheme eq "svn") { 1069 1090 pb_system("svn copy -m \"Creation of $newurl from $oldurl\" $oldurl $newurl","Copying $oldurl to $newurl "); 1070 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "flat") {1071 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "cvs") {1091 } elsif ($scheme eq "flat") { 1092 } elsif ($scheme eq "cvs") { 1072 1093 } else { 1073 die "cms $ cms->{$ENV{'PBPROJ'}}unknown";1094 die "cms $scheme unknown"; 1074 1095 } 1075 1096 } 1076 1097 1077 1098 sub pb_cms_checkout { 1078 my $ cms= shift;1099 my $scheme = shift; 1079 1100 my $url = shift; 1080 1101 my $destination = shift; 1081 1102 1082 if ($ cms->{$ENV{'PBPROJ'}} eq "svn") {1103 if ($scheme =~ /^svn/) { 1083 1104 pb_system("svn co $url $destination","Checking $url to $destination "); 1084 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "flat") {1085 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "cvs") {1105 } elsif ($scheme eq "flat") { 1106 } elsif ($scheme eq "cvs") { 1086 1107 } else { 1087 die "cms $ cms->{$ENV{'PBPROJ'}}unknown";1108 die "cms $scheme unknown"; 1088 1109 } 1089 1110 } 1090 1111 1091 1112 sub pb_cms_checkin { 1092 my $ cms= shift;1113 my $scheme = shift; 1093 1114 my $dir = shift; 1094 1115 1095 1116 my $ver = basename($dir); 1096 if ($ cms->{$ENV{'PBPROJ'}}eq "svn") {1117 if ($scheme eq "svn") { 1097 1118 pb_system("svn ci -m \"Updated to $ver\" $dir","Checking in $dir"); 1098 1119 pb_system("svn up $dir","Updating $dir"); 1099 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "flat") {1100 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "cvs") {1120 } elsif ($scheme eq "flat") { 1121 } elsif ($scheme eq "cvs") { 1101 1122 } else { 1102 die "cms $ cms->{$ENV{'PBPROJ'}}unknown";1123 die "cms $scheme unknown"; 1103 1124 } 1104 1125 } 1105 1126 1106 1127 sub pb_cms_isdiff { 1107 my $ cms= shift;1108 1109 if ($ cms->{$ENV{'PBPROJ'}}eq "svn") {1128 my $scheme = shift; 1129 1130 if ($scheme eq "svn") { 1110 1131 open(PIPE,"svn diff $ENV{'PBROOT'} |") || die "Unable to get svn diff from $ENV{'PBROOT'}"; 1111 1132 my $l = 0; … … 1114 1135 } 1115 1136 return($l); 1116 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "flat") {1117 } elsif ($ cms->{$ENV{'PBPROJ'}}eq "cvs") {1137 } elsif ($scheme eq "flat") { 1138 } elsif ($scheme eq "cvs") { 1118 1139 } else { 1119 die "cms $ cms->{$ENV{'PBPROJ'}}unknown";1140 die "cms $scheme unknown"; 1120 1141 } 1121 1142 } … … 1126 1147 1127 1148 sub pb_get_filters { 1128 1129 # For the moment not dynamic1130 my $debug = 0; # Debug level1131 my $LOG = *STDOUT; # Where to log1132 1149 1133 1150 my @ffiles; … … 1172 1189 } 1173 1190 if (@ffiles) { 1174 p rint $LOG "DEBUG ffiles: ".Dumper(\@ffiles)."\n" if ($debug >= 1);1191 pb_log(2,"DEBUG ffiles: ".Dumper(\@ffiles)."\n"); 1175 1192 1176 1193 foreach my $f (@ffiles) { … … 1184 1201 1185 1202 $ptr = $h{"filter"}; 1186 p rint $LOG "DEBUG f:".Dumper($ptr)."\n" if ($debug >= 1);1203 pb_log(2,"DEBUG f:".Dumper($ptr)."\n"); 1187 1204 } 1188 1205 } else { … … 1213 1230 my $chglog = shift || undef; 1214 1231 1215 # For the moment not dynamic 1216 my $debug = 0; # Debug level 1217 my $LOG = *STDOUT; # Where to log 1218 1219 print $LOG "DEBUG: From $f to $destfile\n" if ($debug >= 1); 1232 pb_log(2,"DEBUG: From $f to $destfile\n"); 1220 1233 pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile)); 1221 1234 open(DEST,"> $destfile") || die "Unable to create $destfile"; … … 1225 1238 foreach my $s (keys %filter) { 1226 1239 # Process single variables 1227 p rint $LOG "DEBUG filter{$s}: $filter{$s}\n" if ($debug >= 1);1240 pb_log(2,"DEBUG filter{$s}: $filter{$s}\n"); 1228 1241 my $tmp = $filter{$s}; 1229 1242 next if (not defined $tmp); 1230 1243 # Expand variables if any single one found 1231 p rint $LOG "DEBUG tmp: $tmp\n" if ($debug >= 1);1244 pb_log(2,"DEBUG tmp: $tmp\n"); 1232 1245 if ($tmp =~ /\$/) { 1233 1246 eval { $tmp =~ s/(\$\w+)/$1/eeg }; … … 1245 1258 close(FILE); 1246 1259 close(DEST); 1260 } 1261 1262 # Function which applies filter on files (external call) 1263 sub pb_filter_file_inplace { 1264 1265 my $ptr=shift; 1266 my %filter=%$ptr; 1267 my $destfile=shift; 1268 my $pbproj=shift; 1269 my $pbpkg=shift; 1270 my $pbver=shift; 1271 my $pbtag=shift; 1272 my $pbrev=shift; 1273 my $pbdate=shift; 1274 my $pbpackager=shift; 1275 1276 my $cp = "$ENV{'PBTMP'}/".basename($destfile); 1277 copy($destfile,$cp) || die "Unable to create $cp"; 1278 1279 pb_filter_file($cp,$ptr,$destfile,$pbproj,$pbpkg,$pbver,$pbtag,$pbrev,$pbdate,$pbpackager); 1280 unlink $cp; 1247 1281 } 1248 1282 … … 1262 1296 my $pbpackager=shift; 1263 1297 1264 # For the moment not dynamic 1265 my $debug = 0; # Debug level 1266 my $LOG = *STDOUT; # Where to log 1267 1268 print $LOG "DEBUG: From $f to $destfile\n" if ($debug >= 1); 1298 pb_log(2,"DEBUG: From $f to $destfile\n"); 1269 1299 pb_mkdir_p(dirname($destfile)) if (! -d dirname($destfile)); 1270 1300 open(DEST,"> $destfile") || die "Unable to create $destfile"; … … 1274 1304 foreach my $s (keys %filter) { 1275 1305 # Process single variables 1276 p rint $LOG "DEBUG filter{$s}: $filter{$s}\n" if ($debug > 1);1306 pb_log(2,"DEBUG filter{$s}: $filter{$s}\n"); 1277 1307 my $tmp = $filter{$s}; 1278 1308 next if (not defined $tmp); … … 1289 1319 } 1290 1320 1321 sub pb_log_init { 1322 1323 $debug = shift || 0; 1324 $LOG = shift || \*STDOUT; 1325 1326 } 1327 1328 sub pb_log { 1329 1330 my $dlevel = shift; 1331 my $msg = shift; 1332 1333 print $LOG "$msg\n" if ($dlevel >= $debug); 1334 } 1291 1335 1292 1336 1;
Note:
See TracChangeset
for help on using the changeset viewer.