Subversion Repositories DevTools

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
392 dpurdie 1
#! perl
2
########################################################################
5710 dpurdie 3
# Copyright (c) VIX TECHNOLOGY (AUST) LTD
392 dpurdie 4
#
5
# Module name   : extract_version_history.pl
6
# Module type   : Makefile system
7
# Compiler(s)   : n/a
8
# Environment(s): jats
9
#
10
# Description   : Given a package name and version, this program will interogate
11
#                 the release manager database and create a directed graph of
12
#                 the packages version history
13
#
14
#......................................................................#
15
 
16
require 5.006_001;
17
use strict;
18
use warnings;
19
 
20
use Pod::Usage;
21
use Getopt::Long;
22
 
23
use JatsError;
24
use JatsVersionUtils;
25
use JatsRmApi;
26
 
27
#use Data::Dumper;
28
use DBI;
29
use Cwd;
30
 
31
my $GBE_PERL     = $ENV{'GBE_PERL'};        # Essential ENV variables
32
my $GBE_CORE     = $ENV{'GBE_CORE'};
33
 
34
my $PNAME;
35
my $PVER;
36
my $EXT;
37
my $RM_DB;
38
my %VERSION_by_PVID;
39
my %NEXT;
40
 
41
#
42
#   Options
43
#
44
my $opt_help = 0;
45
my $opt_verbose = 0;
46
my $opt_show_extract = 0;
47
 
48
my $result = GetOptions (
49
                "help|h:+"          => \$opt_help,
50
                "manual:3"          => \$opt_help,
51
                "verbose:+"         => \$opt_verbose,       # flag or number
52
                "show:+"            => \$opt_show_extract,
53
                );
54
 
55
#
56
#   Process help and manual options
57
#
58
pod2usage(-verbose => 0)  if ($opt_help == 1  || ! $result);
59
pod2usage(-verbose => 1)  if ($opt_help == 2);
60
pod2usage(-verbose => 2)  if ($opt_help > 2);
61
 
62
#-------------------------------------------------------------------------------
63
# Function        : getPkgDetailsByName
64
#
65
# Description     : Determine the PVID for a given package name and version
66
#
67
# Inputs          : $pname          - Package name
68
#                   $pver           - Package Version
69
#
70
# Returns         : PV_ID, PKG_ID
71
#
72
 
73
sub getPkgDetailsByName
74
{
75
    my ($pname, $pver) = @_;
76
    my $pv_id;
77
    my $pkg_id;
78
    my (@row);
79
 
80
    connectRM(\$RM_DB) unless ($RM_DB);
81
 
82
    # First get details for a given package version
83
 
84
    my $m_sqlstr = "SELECT pv.PV_ID, pv.PKG_ID, pkg.PKG_NAME, pv.PKG_VERSION" .
85
                    " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv, RELEASE_MANAGER.PACKAGES pkg" .
86
                    " WHERE pkg.PKG_NAME = \'$pname\' AND pv.PKG_VERSION = \'$pver\' AND pv.PKG_ID = pkg.PKG_ID";
87
    my $sth = $RM_DB->prepare($m_sqlstr);
88
    if ( defined($sth) )
89
    {
90
        if ( $sth->execute( ) )
91
        {
92
            if ( $sth->rows )
93
            {
94
                while ( @row = $sth->fetchrow_array )
95
                {
96
                    $pv_id = $row[0];
97
                    $pkg_id = $row[1];
98
                    my $name = $row[2];
99
                    my $ver = $row[3];
100
                    Verbose( "getPkgDetailsByName :PV_ID= $pv_id, $pkg_id");
101
                }
102
            }
103
            else
104
            {
105
                Error ("No data");
106
            }
107
            $sth->finish();
108
        }
109
        else
110
        {
111
            Error ("Execute Error");
112
        }
113
    }
114
    else
115
    {
116
        Error("Prepare failure" );
117
    }
118
    return ($pv_id, $pkg_id);
119
}
120
 
121
#-------------------------------------------------------------------------------
122
# Function        : getAllVersions
123
#
124
# Description     : Exract all versions of a given package
125
#
126
# Inputs          : $pname          - Package name
127
#                   $pver           - Package Version
128
#                   $ext            - Extension
129
#
130
# Returns         : PV_ID, PKG_ID
131
#
132
 
133
sub getAllVersions
134
{
135
    my ($pv_id, $pkg_id, $ext) = @_;
136
    my (@row);
137
 
138
    connectRM(\$RM_DB) unless ($RM_DB);
139
 
140
    # First get details for a given package version
141
 
142
    my $m_sqlstr = "SELECT pv.PV_ID, pv.LAST_PV_ID,  pv.PKG_VERSION" .
143
                    " FROM RELEASE_MANAGER.PACKAGE_VERSIONS pv" .
144
                    " WHERE pv.PKG_ID = $pkg_id";# and v_ext='$ext'";
145
    my $sth = $RM_DB->prepare($m_sqlstr);
146
    if ( defined($sth) )
147
    {
148
        if ( $sth->execute( ) )
149
        {
150
            if ( $sth->rows )
151
            {
152
                while ( @row = $sth->fetchrow_array )
153
                {
154
                    my $pv_id = $row[0];
155
                    my $pv_last = $row[1];
156
                    my $ver = $row[2];
157
 
158
                    Verbose( "getAllVersions :$pv_id, $pv_last, $ver");
159
                    $VERSION_by_PVID{$pv_id} = $ver;
160
                    push @{$NEXT{$pv_last}},$pv_id;
161
                }
162
            }
163
            else
164
            {
165
                Error ("getAllVersions:No data");
166
            }
167
            $sth->finish();
168
        }
169
        else
170
        {
171
            Error ("getAllVersions:Execute Error");
172
        }
173
    }
174
    else
175
    {
176
        Error("getAllVersions:Prepare failure" );
177
    }
178
}
179
 
180
#-------------------------------------------------------------------------------
181
# Function        : plist
182
#
183
# Description     : Generate an entry list as text
184
#                   Replace "." with "_" since DOT doesn't like .'s
185
#                   Seperate the arguments
186
#
187
# Inputs          : $pref       - Prefix string
188
#                   @_          - An array of entries to process
189
#
190
# Returns         : A string
191
#
192
sub plist
193
{
194
    my $pref = shift;
195
    my $result = "";
196
    foreach  ( @_ )
197
    {
198
        my $x = $_;
199
        $x =~ s~\.~_~g;
200
        $result .= '"' . $x . '"' . $pref;
201
    }
202
    return $result;
203
}
204
 
205
sub pentry
206
{
207
 
208
    my $result = "";
209
    foreach  ( @_ )
210
    {
211
        my $x = $_;
212
        $x =~ s~\.~_~g;
213
        $result .= '"' . $x . '"'
214
    }
215
    return $result;
216
}
217
 
218
 
219
#-------------------------------------------------------------------------------
220
# Function        : Main
221
#
222
# Description     :
223
#
224
# Inputs          :
225
#
226
# Returns         :
227
#
228
 
229
ErrorConfig( 'name'    =>'ExtractVer',
230
             'verbose' => $opt_verbose );
231
 
232
#
233
#   Determine root package
234
#
235
unless ( $ARGV[0] && $ARGV[1] )
236
{
237
    print "Specify a package as 'name' 'version'\n";
238
    exit;
239
}
240
$PNAME = $ARGV[0];
241
$PVER = $ARGV[1];
242
my $PV_ID;
243
my $PKG_ID;
244
$PVER =~ m~(\.[a-z]+)$~;
245
$EXT = $1;
246
 
247
($PV_ID, $PKG_ID) = getPkgDetailsByName( $PNAME, $PVER );
248
print "Pkg: $PV_ID, $PKG_ID, $EXT\n";
249
getAllVersions( $PV_ID, $PKG_ID, $EXT );
250
 
251
#DebugDumpData("Next", \%NEXT );
252
 
253
 
254
my $filebase = "${PNAME}_vtree";
255
open (FH, ">$filebase.dot" ) or die "Cannot open output";
256
print FH "digraph world {\n";
257
#print FH "\trankdir=LR;\n";
258
print FH "\tnode[fontsize=24];\n";
259
#print FH "\t{rank=min; ", pentry(@ROOT_PVIDS) , "; }\n";
260
#print FH "\t{root=", pentry($ROOT_PVIDS[0]), "; }\n";
261
 
262
 
263
foreach my $entry ( keys(%NEXT) )
264
{
265
    my $ref = $NEXT{$entry};
266
    my @data;
267
    foreach my $pvid (@{$ref} )
268
    {
269
        push @data, $VERSION_by_PVID{$pvid};
270
    }
271
    print FH "\t", pentry($VERSION_by_PVID{$entry})  ," -> { ", plist ( ' ; ', @data ), " }\n";
272
}
273
 
274
 
275
 
276
print FH "\n};\n";
277
close FH;
278
 
279
#
280
#   Convert DOT to a SVG
281
#
282
system( "dot $filebase.dot -Tjpg -o$filebase.jpg" );
283
system( "dot $filebase.dot -Tsvg -o$filebase.svg" );
284
 
285
print "Generated: $filebase.dot\n";
286
print "Generated: $filebase.jpg\n";
287
print "Generated: $filebase.svg\n";
288
 
289
 
290
 
291
#-------------------------------------------------------------------------------
292
#   Documentation
293
#
294
 
295
=pod
296
 
297
=head1 NAME
298
 
299
jats etool extract_uses - Graph build dependencies
300
 
301
=head1 SYNOPSIS
302
 
303
  jats etool extract_uses [options] PackageName/Version Pairs
304
 
305
 Options:
306
    -help               - brief help message
307
    -help -help         - Detailed help message
308
    -man                - Full documentation
309
    -verbose            - Verbose operation
310
    -show               - Show 'jats extract' commands
311
 
312
=head1 OPTIONS
313
 
314
=over 8
315
 
316
=item B<-help>
317
 
318
Print a brief help message and exits.
319
 
320
=item B<-help -help>
321
 
322
Print a detailed help message with an explanation for each option.
323
 
324
=item B<-man>
325
 
326
Prints the manual page and exits.
327
 
328
=item B<-verbose>
329
 
330
Increases program output. This option may be specified multiple times
331
 
332
 
333
This option specifies the Release, within the Release Manager Database, that will
334
be used to update the build dependency file.
335
 
336
The Release Tag is provided by the Release Manager Web Page, or by the -Show option
337
of this utility.
338
 
339
=back
340
 
341
=head1 DESCRIPTION
342
 
343
This utilty will display the dependency tree for packages used by the specified
344
packages.
345
 
346
=cut
347
 
348
 
349