Subversion Repositories DevTools

Rev

Rev 396 | Rev 1270 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 396 Rev 1197
Line 30... Line 30...
30
use HTTP::Date;
30
use HTTP::Date;
31
use JatsProperties;
31
use JatsProperties;
32
use JatsEnv;
32
use JatsEnv;
33
use ConfigurationFile;
33
use ConfigurationFile;
34
use JatsSvn qw(:All);
34
use JatsSvn qw(:All);
-
 
35
use JatsLocateFiles;
35
 
36
 
36
 
37
 
37
#use Data::Dumper;
38
#use Data::Dumper;
38
use Fcntl ':flock'; # import LOCK_* constants
39
use Fcntl ':flock'; # import LOCK_* constants
39
use Cwd;
40
use Cwd;
Line 62... Line 63...
62
my $opt_log = 0;
63
my $opt_log = 0;
63
my @opt_tip;
64
my @opt_tip;
64
my $opt_postimage = 1;
65
my $opt_postimage = 1;
65
my $opt_workDir = '/work';
66
my $opt_workDir = '/work';
66
my $opt_vobMap;
67
my $opt_vobMap;
-
 
68
my $opt_preserveProjectBase;
-
 
69
my $opt_ignoreProjectBaseErrors;
67
 
70
 
68
################################################################################
71
################################################################################
69
#   List of Projects Suffixes and Branch Names to be used within SVN
72
#   List of Projects Suffixes and Branch Names to be used within SVN
70
#
73
#
71
#       Name        - Name of branch for the project
74
#       Name        - Name of branch for the project
Line 120... Line 123...
120
    '.pxxx.sydddd'  => '.syd',
123
    '.pxxx.sydddd'  => '.syd',
121
    '.oslo'         => '.oso',
124
    '.oslo'         => '.oso',
122
);
125
);
123
 
126
 
124
my %specialPackages = (
127
my %specialPackages = (
125
#    'core_devl' =>  ',all,protected,',
128
    'core_devl' =>  ',all,protected,',
126
    'core_devl' =>  ',all,',
129
#    'core_devl' =>  ',all,',
127
    'daf_utils_mos' => ',flat,',
130
    'daf_utils_mos' => ',flat,',
128
    'mos_packager'  => ',all,',
131
    'mos_packager'  => ',all,',
129
 
132
 
130
    # Need to be handled in a special manner
133
    # Need to be handled in a special manner
131
    # Not done by this utility
134
    # Not done by this utility
Line 135... Line 138...
135
    'linux_drivers_cobra'   => ',protected,',
138
    'linux_drivers_cobra'   => ',protected,',
136
    'linux_drivers_bcp4600' => ',protected,',
139
    'linux_drivers_bcp4600' => ',protected,',
137
    'linux_drivers_etx86'   => ',protected,',
140
    'linux_drivers_etx86'   => ',protected,',
138
    'linux_drivers_tp5600'  => ',protected,',
141
    'linux_drivers_tp5600'  => ',protected,',
139
 
142
 
-
 
143
    'ftp'                   => 'SetProjectBase,',
-
 
144
 
-
 
145
    'icl'                   => 'IgnoreProjectBase,',
-
 
146
    'itso'                  => 'IgnoreProjectBase,',
-
 
147
    'daf_osa_mos'           => 'IgnoreProjectBase,',
-
 
148
    'daf_utils_mos'         => 'IgnoreProjectBase,',
-
 
149
    'itso_ud'               => 'IgnoreProjectBase,',
-
 
150
#    'mos_api'               => 'IgnoreProjectBase,',
-
 
151
#    'mos_fonts'             => 'IgnoreProjectBase,',
-
 
152
#    'sntp'                  => 'IgnoreProjectBase,',
-
 
153
#    'time_it'               => 'IgnoreProjectBase,',
-
 
154
 
140
);
155
);
141
 
156
 
142
my %notCots = (
157
my %notCots = (
143
    'isl'       => 1,
158
    'isl'       => 1,
144
);
159
);
Line 545... Line 560...
545
        }
560
        }
546
 
561
 
547
        if ( index( $data, 'flat,' ) >= 0) {
562
        if ( index( $data, 'flat,' ) >= 0) {
548
            $opt_flat = 1;
563
            $opt_flat = 1;
549
        }
564
        }
-
 
565
 
-
 
566
        if ( index( $data, 'SetProjectBase,' ) >= 0) {
-
 
567
            $opt_preserveProjectBase = 1;
-
 
568
            $opt_ignoreProjectBaseErrors = 1;
-
 
569
            Message ("Preserving ProjectBase");
550
        
570
        }
-
 
571
 
-
 
572
        if ( index( $data, 'IgnoreProjectBase,' ) >= 0) {
-
 
573
            $opt_ignoreProjectBaseErrors = 1;
-
 
574
            Message ("Ignore ProjectBase Errors");
-
 
575
        }
-
 
576
 
551
    }
577
    }
552
 
578
 
553
    Message("Package Type: $packageType, $pruneModeString");
579
    Message("Package Type: $packageType, $pruneModeString");
554
}
580
}
555
 
581
 
Line 1358... Line 1384...
1358
    #   Sava data
1384
    #   Sava data
1359
    #
1385
    #
1360
    $versions{$entry}{rmRef} = $data{rmRef};
1386
    $versions{$entry}{rmRef} = $data{rmRef};
1361
    $versions{$entry}{errStr} = $data{errStr};
1387
    $versions{$entry}{errStr} = $data{errStr};
1362
    $versions{$entry}{errFlags} = $flags;
1388
    $versions{$entry}{errFlags} = $flags;
-
 
1389
    $versions{$entry}{BadProjectBase} = $data{BadProjectBase};
1363
 
1390
    
1364
    #
1391
    #
1365
    #   Delete the created view
1392
    #   Delete the created view
1366
    #   Its just a directory, so delete it
1393
    #   Its just a directory, so delete it
1367
    #
1394
    #
1368
    if ( $data{ViewRoot} && -d $data{ViewRoot})
1395
    if ( $data{ViewRoot} && -d $data{ViewRoot})
Line 1468... Line 1495...
1468
    #
1495
    #
1469
    #   Create CC view
1496
    #   Create CC view
1470
    #   Import into Subversion View
1497
    #   Import into Subversion View
1471
    #
1498
    #
1472
    $data->{ViewRoot} = $opt_name ? $opt_name : "$cc_label";
1499
    $data->{ViewRoot} = $opt_name ? $opt_name : "$cc_label";
1473
    $data->{ViewPath} =  $data->{ViewRoot} . '/' . $cc_path;
1500
    $data->{ViewPath} =  $data->{ViewRoot} . $cc_path;
-
 
1501
 
-
 
1502
    if ( $opt_preserveProjectBase )
-
 
1503
    {
-
 
1504
        my $cc_vob = $cc_path;
-
 
1505
        $cc_vob =~ s~^/~~;
-
 
1506
        $cc_vob =~ s~/.*~~;
-
 
1507
        $data->{ViewPath} =  $data->{ViewRoot} . '/' . $cc_vob;
-
 
1508
        Message ("Preserving Project Base");
-
 
1509
    }
1474
    $data->{ViewPath} =~  tr~/~/~s;
1510
    $data->{ViewPath} =~  tr~/~/~s;
1475
 
1511
 
1476
    if ( $opt_reuse && -d $data->{ViewPath}  )
1512
    if ( $opt_reuse && -d $data->{ViewPath}  )
1477
    {
1513
    {
1478
        Message ("Reusing view: $cc_label");
1514
        Message ("Reusing view: $cc_label");
Line 1492... Line 1528...
1492
            $data->{errStr} = 'Failed to extract files from CC';
1528
            $data->{errStr} = 'Failed to extract files from CC';
1493
            return 2;
1529
            return 2;
1494
        }
1530
        }
1495
    }
1531
    }
1496
 
1532
 
-
 
1533
 
-
 
1534
    #
-
 
1535
    #   Some really ugly packages make use of a Jats feature called 'SetProjectBase'
-
 
1536
    #   Detect such packages as we will need to handle them differently
-
 
1537
    #   Can't really handle it on the fly
-
 
1538
    #   All we can do is detct it and report it - at the moment
-
 
1539
    #
-
 
1540
    if (detectProjectBaseUsage($data, $cc_path) )
-
 
1541
    {
-
 
1542
        unless ( $opt_ignoreProjectBaseErrors )
-
 
1543
        {
-
 
1544
            $data->{BadProjectBase}++;
-
 
1545
            $data->{errStr} = 'Bad usage of ProjectBase detected';
-
 
1546
            return 14;
-
 
1547
        }
-
 
1548
    }
-
 
1549
 
1497
    #
1550
    #
1498
    #   Have a CC view
1551
    #   Have a CC view
1499
    #   Now we can create the SVN package and branching point before we
1552
    #   Now we can create the SVN package and branching point before we
1500
    #   import the CC data into SVN
1553
    #   import the CC data into SVN
1501
    #
1554
    #
Line 1893... Line 1946...
1893
    }
1946
    }
1894
 
1947
 
1895
    Message ("All Done");
1948
    Message ("All Done");
1896
}
1949
}
1897
 
1950
 
-
 
1951
#-------------------------------------------------------------------------------
-
 
1952
# Function        : detectProjectBaseUsage
-
 
1953
#
-
 
1954
# Description     : Detect and report usage of the SetProjectBase directive
-
 
1955
#
-
 
1956
# Inputs          : $data               - Ref to a hash of bits
-
 
1957
#                   $cc_path            - Packages cc_path
-
 
1958
#
-
 
1959
# Returns         : true    - Bad usage (Really good usage not detected)
-
 
1960
#                   false   - Good usage detected
-
 
1961
#
-
 
1962
sub detectProjectBaseUsage
-
 
1963
{
-
 
1964
    my ($data, $cc_path) = @_;
-
 
1965
    my $retval = 0;
-
 
1966
    my $eSuf = $opt_ignoreProjectBaseErrors ? '' : 'Error';
-
 
1967
 
-
 
1968
    #
-
 
1969
    #   Find makefile.pl
-
 
1970
    #
-
 
1971
    Message ("Locate JATS makefiles");
-
 
1972
    my $usesProjectBase = 0;
-
 
1973
    my $definesProjectBase = 0;
-
 
1974
    my $definitionError = 0;
-
 
1975
 
-
 
1976
    my $search = JatsLocateFiles->new("--Recurse=1",
-
 
1977
                                       "--FilterIn=makefile.pl",
-
 
1978
                                       );
-
 
1979
    my @makefiles = $search->search($data->{ViewRoot});
-
 
1980
    foreach my $file ( @makefiles )
-
 
1981
    {
-
 
1982
        if ( open( my $fh, '<', "$data->{ViewRoot}/$file" ) )
-
 
1983
        {
-
 
1984
            while ( <$fh> )
-
 
1985
            {
-
 
1986
                s~\s+$~~;
-
 
1987
                s~^\s+~~;
-
 
1988
                next if ( m~^#~ );
-
 
1989
 
-
 
1990
                if ( m~\$ProjectBase~ )
-
 
1991
                {
-
 
1992
                    $usesProjectBase++;
-
 
1993
                    Message ("Project Base Use: $_");
-
 
1994
                    $data->{UsesProjectBase}++;
-
 
1995
                }
-
 
1996
 
-
 
1997
                if ( m~^SetProjectBase~ )
-
 
1998
                {
-
 
1999
                    $definesProjectBase++;
-
 
2000
                    $data->{DefinesProjectBase}++;
-
 
2001
                    Warning ("Package uses SetProjectBase:",
-
 
2002
                             "Line: " . $_,
-
 
2003
                             "Root: " . "$data->{ViewRoot}",
-
 
2004
                             "File: " . "$data->{ViewRoot}/$file",
-
 
2005
                            );
-
 
2006
 
-
 
2007
                    # The only problem is if the user attempts to escape
-
 
2008
                    # from the root of the view.
-
 
2009
                    #
-
 
2010
                    # Examine the depth of the makefile with the directive
-
 
2011
                    # Examine the depth of the view base
-
 
2012
                    #
-
 
2013
                    #
-
 
2014
                    # Locate the build.pl file
-
 
2015
                    # This is the basis for for the directive
-
 
2016
                    #
-
 
2017
                    my $blevel;
-
 
2018
                    my @bpaths = split ('/', $file );
-
 
2019
                    while ( @bpaths )
-
 
2020
                    {
-
 
2021
                        $bpaths[-1] = 'build.pl';
-
 
2022
                        my $bfile = join '/', @bpaths ;
-
 
2023
                        if ( -f "$data->{ViewRoot}/$bfile" )
-
 
2024
                        {
-
 
2025
                            $blevel = scalar @bpaths;
-
 
2026
                            last;
-
 
2027
                        }
-
 
2028
                        pop @bpaths;
-
 
2029
                    }
-
 
2030
                    unless (defined $blevel)
-
 
2031
                    {
-
 
2032
                        Warning ("SetProjectBase$eSuf calculation failed - can't find build.pl");
-
 
2033
                        $retval = 1;
-
 
2034
                    }
-
 
2035
                    else
-
 
2036
                    {
-
 
2037
                        #
-
 
2038
                        #   Determine the depth of the view root
-
 
2039
                        #   This is given by cc_path, but cc_path has a leading /
-
 
2040
                        #
-
 
2041
                        my @cpaths = split ('/', $cc_path );
-
 
2042
                        my $clevel = (scalar @cpaths) - 1;
-
 
2043
                        my $max_up = $blevel - $clevel - 1;
-
 
2044
 
-
 
2045
                        m~--Up=(\d+)~i;
-
 
2046
                        my $ulevel = $1;
-
 
2047
                        if ( defined $ulevel )
-
 
2048
                        {
-
 
2049
                            my @paths = split ('/', $file );
-
 
2050
                            my $plevel = scalar @paths;
-
 
2051
 
-
 
2052
#print "--- blevel: $blevel\n";
-
 
2053
#print "--- bpaths: @bpaths\n";
-
 
2054
#print "--- ulevel: $ulevel\n";
-
 
2055
#print "--- paths: @paths\n";
-
 
2056
#print "--- plevel: $plevel\n";
-
 
2057
#print "--- cpaths: @cpaths\n";
-
 
2058
#print "--- clevel: $clevel\n";
-
 
2059
#print "--- max_up: $max_up\n";
-
 
2060
 
-
 
2061
                            if ( $ulevel > $max_up )
-
 
2062
                            {
-
 
2063
                                Warning ("SetProjectBase escapes view. MaxUp: $max_up, Up: $ulevel");
-
 
2064
                                $definitionError++;
-
 
2065
                            }
-
 
2066
                        }
-
 
2067
                        else
-
 
2068
                        {
-
 
2069
                            $retval = 1;
-
 
2070
                            Warning ("SetProjectBase$eSuf MAY escape view - can't detect level")
-
 
2071
                        }
-
 
2072
                    }
-
 
2073
                }
-
 
2074
            }
-
 
2075
            close $fh;
-
 
2076
        }
-
 
2077
        else
-
 
2078
        {
-
 
2079
            Warning ("SetProjectBase$eSuf - Cannot open makefile: $file");
-
 
2080
            $retval = 1;
-
 
2081
        }
-
 
2082
    }
-
 
2083
 
-
 
2084
    #
-
 
2085
    #   Detect defined, but not used
-
 
2086
    #
-
 
2087
    if ( $usesProjectBase && ! $definesProjectBase )
-
 
2088
    {
-
 
2089
        Warning ("SetProjectBase - Uses ProjectBase without defining it");
-
 
2090
    }
-
 
2091
 
-
 
2092
    if ( ! $usesProjectBase && $definesProjectBase )
-
 
2093
    {
-
 
2094
        Warning ("SetProjectBase - Defines ProjectBase without using it");
-
 
2095
    }
-
 
2096
 
-
 
2097
    if ( $usesProjectBase && $definesProjectBase && $definitionError )
-
 
2098
    {
-
 
2099
        Warning ("SetProjectBase$eSuf - Problem detected");
-
 
2100
        $retval = 1;
-
 
2101
    }
-
 
2102
    return $retval;
-
 
2103
}
-
 
2104
 
-
 
2105
 
-
 
2106
#-------------------------------------------------------------------------------
-
 
2107
# Function        : JatsToolPrint
-
 
2108
#
-
 
2109
# Description     : Print and Execuate a JatsTool command
-
 
2110
#
-
 
2111
# Inputs          : 
-
 
2112
#
-
 
2113
# Returns         : 
-
 
2114
#
-
 
2115
 
1898
sub JatsToolPrint
2116
sub JatsToolPrint
1899
{
2117
{
1900
    Information ("Command: @_");
2118
    Information ("Command: @_");
1901
    JatsTool @_;
2119
    JatsTool @_;
1902
}
2120
}
Line 2567... Line 2785...
2567
        push @text, 'Creation Date: yyyy-mm-dd';
2785
        push @text, 'Creation Date: yyyy-mm-dd';
2568
        push @text, '(Coded information)';
2786
        push @text, '(Coded information)';
2569
        push @text, '|{Code';
2787
        push @text, '|{Code';
2570
        push @text, '|{N: Not Locked';
2788
        push @text, '|{N: Not Locked';
2571
        push @text, 'b: Bad Singleton';
2789
        push @text, 'b: Bad Singleton';
2572
        push @text, 'd: A dependency';
-
 
2573
        push @text, 'B: Bad VCS Tag';
2790
        push @text, 'B: Bad VCS Tag';
2574
        push @text, 'D: DeadWood';
2791
        push @text, 'D: DeadWood';
2575
        push @text, 'e: Essential BOM Version';
2792
        push @text, 'E: Essential Version';
2576
        push @text, 'E: Essential Release Version';
-
 
2577
        push @text, 'G: Glued into Version Tree';
2793
        push @text, 'G: Glued into Version Tree';
2578
        push @text, 'S: Splitpoint';
2794
        push @text, 'S: Splitpoint';
2579
        push @text, 't: Glued into Project Tree';
2795
        push @text, 't: Glued into Project Tree';
2580
        push @text, 'T: Tip version';
2796
        push @text, 'T: Tip version';
2581
        push @text, 'V: In SVN';
2797
        push @text, 'V: In SVN';
Line 2635... Line 2851...
2635
#        push @label, $entry;       # Add PVID
2851
#        push @label, $entry;       # Add PVID
2636
        push @label, substr( $versions{$entry}{created}, 0, 10); #  2008-02-19
2852
        push @label, substr( $versions{$entry}{created}, 0, 10); #  2008-02-19
2637
#        push @label, 'V=' . $versions{$entry}{maxVersion};
2853
#        push @label, 'V=' . $versions{$entry}{maxVersion};
2638
#        push @label, 'B=' . $versions{$entry}{svnBranchTip} if ( exists $versions{$entry}{svnBranchTip} );
2854
#        push @label, 'B=' . $versions{$entry}{svnBranchTip} if ( exists $versions{$entry}{svnBranchTip} );
2639
 
2855
 
2640
        my $reason = '';
-
 
2641
        if (exists $versions{$entry}{Essential})
-
 
2642
        {
-
 
2643
            $reason = 'E';
-
 
2644
            if (exists $versions{$entry}{Reason})
-
 
2645
            {
-
 
2646
                if ( $versions{$entry}{Reason} =~ m~bom~ )
-
 
2647
                {
-
 
2648
                    $reason = 'e';
-
 
2649
                }
-
 
2650
                if ( $versions{$entry}{Reason} =~ m~Depend~ )
-
 
2651
                {
-
 
2652
                    $reason .= 'd';
-
 
2653
                }
-
 
2654
            }
-
 
2655
        }
-
 
2656
 
2856
 
2657
        my $stateText = '';
2857
        my $stateText = '';
2658
        $stateText .= 'N' if ($versions{$entry}{locked} eq 'N');
2858
        $stateText .= 'N' if ($versions{$entry}{locked} eq 'N');
2659
        $stateText .= 'b' if (exists $versions{$entry}{badSingleton});
2859
        $stateText .= 'b' if (exists $versions{$entry}{badSingleton});
2660
        $stateText .= 'B' if (exists $versions{$entry}{badVcsTag});
2860
        $stateText .= 'B' if (exists $versions{$entry}{badVcsTag});
2661
        $stateText .= 'G' if (exists $versions{$entry}{GluedIn});
2861
        $stateText .= 'G' if (exists $versions{$entry}{GluedIn});
2662
        $stateText .= 't' if (exists $versions{$entry}{MakeTree});
2862
        $stateText .= 't' if (exists $versions{$entry}{MakeTree});
2663
#        $stateText .= 'E' if (exists $versions{$entry}{Essential});
2863
        $stateText .= 'E' if (exists $versions{$entry}{Essential});
2664
        $stateText .= $reason if ( $reason );
-
 
2665
        $stateText .= 'D' if (exists $versions{$entry}{DeadWood});
2864
        $stateText .= 'D' if (exists $versions{$entry}{DeadWood});
2666
        $stateText .= 'S' if (exists $versions{$entry}{EssentialSplitPoint} && $versions{$entry}{EssentialSplitPoint} > 1 );
2865
        $stateText .= 'S' if (exists $versions{$entry}{EssentialSplitPoint} && $versions{$entry}{EssentialSplitPoint} > 1 );
2667
        $stateText .= 'T' if (exists $versions{$entry}{Tip} );
2866
        $stateText .= 'T' if (exists $versions{$entry}{Tip} );
2668
        $stateText .= 'V' if (exists $versions{$entry}{isSvn} );
2867
        $stateText .= 'V' if (exists $versions{$entry}{isSvn} );
2669
        $stateText .= '+' if (exists $versions{$entry}{svnVersion} );
2868
        $stateText .= '+' if (exists $versions{$entry}{svnVersion} );
Line 2912... Line 3111...
2912
        next unless ( exists  $pkg_ids{ $ScmPackages{$_}{pkgid} } );
3111
        next unless ( exists  $pkg_ids{ $ScmPackages{$_}{pkgid} } );
2913
        push @EssentialPackages, $_;
3112
        push @EssentialPackages, $_;
2914
        Error ("Essential Package Version not in extracted Release Manager Data: $_")
3113
        Error ("Essential Package Version not in extracted Release Manager Data: $_")
2915
            unless ( exists $versions{$_} );
3114
            unless ( exists $versions{$_} );
2916
        $versions{$_}{Essential} = 1;
3115
        $versions{$_}{Essential} = 1;
2917
        $versions{$_}{Reason} = $ScmPackages{$_}{Reason};
-
 
2918
#print "ESSENTIAL: $versions{$_}{name} $versions{$_}{vname} $versions{$_}{Reason}\n";
3116
        #print "ESSENTIAL: $versions{$_}{name} $versions{$_}{vname}\n";
2919
    }
3117
    }
2920
 
3118
 
2921
    #
3119
    #
2922
    #   Free memory
3120
    #   Free memory
2923
    #
3121
    #