Subversion Repositories DevTools

Rev

Rev 1431 | Rev 3347 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
267 dpurdie 1
########################################################################
2
# Copyright ( C ) 2008 ERG Limited, All rights reserved
3
#
4
# Module name   : jats_svnasave_build.pl
5
# Module type   : JATS Utility
6
# Compiler(s)   : Perl
7
# Environment(s): jats
8
#
9
# Description   : Build Daemon Support Utility
10
#                 This utility will:
341 dpurdie 11
#                   +   Assume the CWD is where the build file is located
12
#                   +   Within a version controlled view
267 dpurdie 13
#                   +   Determine a suitable label for the package
14
#                   +   Save the build file in the view
15
#                   +   Label the resultant view
16
#
17
# Usage:        : See POD at end of this file
18
#
19
#               jats etool  jats_svnasave_build
20
#                   -infile     auto.xml/auto.pl
21
#                   -outfile    xxxdepends.xml/build.pl
22
#                   -pname      package_name
23
#                   -pversion   package_version
24
#                   -infofile   path_to_info_file
341 dpurdie 25
#                   -baselabel  View label
353 dpurdie 26
#                   -isawip     Is A WIP (optional)
267 dpurdie 27
#
28
#......................................................................#
29
 
30
use strict;
31
use warnings;
32
use JatsError;
33
use JatsBuildFiles;
34
use JatsSystem;
35
use JatsProperties;
36
use Getopt::Long;
37
use Pod::Usage;                             # required for help support
38
use File::Copy;
39
use JatsSvn;
40
use Cwd;
41
 
42
################################################################################
43
#   Option variables
44
#
45
 
46
my $VERSION = "2.0.0";                      # Update this
47
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
48
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
49
my $opt_infile  = "auto.pl";
50
my $opt_ofile = "build.pl";
51
my $opt_help = 0;
52
my $opt_infofile;
53
my $opt_pname;
54
my $opt_pversion;
341 dpurdie 55
my $opt_baselabel;
353 dpurdie 56
my $opt_isa_wip;
267 dpurdie 57
 
58
#
59
#   Globals
60
#
61
my $root_dir;
62
my $tag_label;
63
 
64
my $ws_root;
65
my $pkg_root;
66
 
67
#
68
#   Configuration options
69
#
70
my $result = GetOptions (
71
                "help:+"        => \$opt_help,              # flag, multiple use allowed
72
                "manual:3"      => \$opt_help,              # flag
73
                "verbose:+"     => \$opt_verbose,           # flag
74
 
75
                "outfile=s"     => \$opt_ofile,             # string
76
                "infile=s"      => \$opt_infile,            # string
77
 
78
                "infofile=s"    => \$opt_infofile,          # string
79
                "pname=s"       => \$opt_pname,             # string
80
                "pversion=s"    => \$opt_pversion,          # string
341 dpurdie 81
                "baselabel=s"   => \$opt_baselabel,         # string
353 dpurdie 82
                "isawip:+"      => \$opt_isa_wip,           # Flag
267 dpurdie 83
 
84
                #
85
                #   Update documentation at the end of the file
86
                #
87
                );
88
 
89
#
90
#   Process help and manual options
91
#
92
pod2usage(-verbose => 0, -message => "Version: $VERSION")  if ($opt_help == 1  || ! $result);
93
pod2usage(-verbose => 1)  if ( $opt_help == 2 );
94
pod2usage(-verbose => 2)  if ( $opt_help > 2 );
95
 
96
#
97
#   Configure the error reporting process now that we have the user options
98
#
99
ErrorConfig( 'name'    =>'SVNABTSAVE',
100
             'verbose' => $opt_verbose,
101
           );
102
 
103
Error ("Input and output file are the same: $opt_infile" )
104
    if ( $opt_infile eq $opt_ofile );
105
 
341 dpurdie 106
Error ("Base Label not provided")
107
    unless ( $opt_baselabel );
108
 
267 dpurdie 109
Error ("Package Name not provided")
110
    unless ( $opt_pname );
111
 
112
Error ("Package Version not provided")
113
    unless ( $opt_pversion );
114
 
115
Warning("Path to info file not provided")
116
    unless ( $opt_infofile );
117
 
118
unlink ($opt_infofile) if $opt_infofile;
119
 
120
#
341 dpurdie 121
#   User must have changed to the directory with build files
267 dpurdie 122
#   Continue with user argument sanity check
123
#
124
Error ("Input file not found: $opt_infile" )
125
    unless ( -f $opt_infile );
126
 
127
Error ("Output file not found: $opt_ofile" )
128
    unless ( -f $opt_ofile );
129
 
130
 
131
#
132
#   Create a SubVersion Session using the current workspace
133
#   as a basis. Error if not a workspace
134
#
1431 dpurdie 135
#   Need abs path so that we can correctly detect modified build files
136
#
137
my $sessionRoot = getcwd();
138
my $session = NewSessionByWS( $sessionRoot );
267 dpurdie 139
 
140
Verbose ("Determine the current workspace root" );
141
$ws_root = $session->SvnLocateWsRoot(1) || '';
142
$pkg_root = $session->Full;
143
 
144
Verbose ("Workspace root: $ws_root");
145
Verbose ("Package root  : $pkg_root");
146
 
147
#
148
#   Determine the desired label for the package
149
#   May need to pick an unassigned label
150
#
151
determine_package_label();
152
 
153
#
154
#   Update the build file
155
#   Under subversion this is a simple 'copy'
156
#
157
Verbose ("Update build files");
158
unlink $opt_ofile;
159
unless ( File::Copy::copy($opt_infile, $opt_ofile) )
160
{
161
    Error("Failed to copy file [$opt_infile] to [$opt_ofile]: $!");
162
    Error ("Updating build files","Reason: $!");
163
}
164
 
165
#
166
#   Change back to original directory
167
#
168
if ( $root_dir )
169
{
170
    chdir $root_dir || Error ("Cannot change directory: $root_dir");
171
}
172
 
173
#
174
#   Label the view
175
#
176
label_build_view();
177
 
178
exit 0;
179
 
180
#-------------------------------------------------------------------------------
181
# Function        : determine_package_label
182
#
183
# Description     : Determine the label that is to be applied to the package
184
#                   There are several cases to consider
185
#                       1) Compatability mode: User provides label
186
#                       2) WIP Mode. Determine name of label to use in rename
187
#                       3) Create a new label
188
#
189
# Inputs          : Globals
190
#
191
# Returns         : Globals
353 dpurdie 192
#                       $tag_label
267 dpurdie 193
#
194
sub determine_package_label
195
{
196
 
197
    #
198
    #   Determine the desired label for the package
199
    #   This is a function of the package name and the package version
200
    #   The two are joined with a '.'
201
    #
202
    $tag_label = $opt_pname . '_' . $opt_pversion;
203
 
204
    #
205
    #   Ensure that desired label is "free", if not then hunt for a new one
206
    #   Determine the name of a 'new' label
207
    #
208
    my $base_label = $tag_label;
209
    my $index = 0;
210
 
211
    while ( ++$index )
212
    {
213
        if ( $index > 20 )
214
        {
215
            Error ("Cannot determine new label. Retry limit exceeded");
216
        }
217
        Verbose2 ("Trying $tag_label");
218
 
219
        if ( $session->SvnValidateTarget (
220
                    'target' => $session->BranchName($tag_label, 'tags' ),
221
                    'test' => 1,
222
                    ))
223
        {
224
            #
225
            #   Label found - so try another
226
            #
227
            Verbose2("Label found. Try another");
228
            $tag_label = $base_label . '.' . $index;
229
            next;
230
        }
231
 
232
        #
233
        #   Warn about non standard label
234
        #
235
        Verbose ("Package will be labeled: $tag_label");
236
        Warning ("Labeling with a non-standard label: $tag_label" )
237
            if ( $index > 1 );
238
        last;
239
    }
240
 
241
    #
242
    #   Free label has been found
243
    #
244
}
245
 
246
#-------------------------------------------------------------------------------
247
# Function        : label_build_view
248
#
249
# Description     : Label the view
250
#
251
#                   Either:
252
#                       Rename the WIP label to required name
253
#                       Label all files in the view
254
#                   
255
#                   Use JATS to do the hard work
256
#
257
#
258
# Inputs          : Globals
259
#
260
# Returns         : 
261
#
262
sub label_build_view
263
{
1329 dpurdie 264
    my $author;
265
 
267 dpurdie 266
    #
1329 dpurdie 267
    #   Determine the author of the workspace - before we update it
268
    #   The original author will be used to mark the work in the repo
269
    #   This better describes the task done
270
    #
271
    $author = $session->{'InfoWs'}{'Last Changed Author'};
272
    Error ("Internal: Svn Session data item 'InfoWs' not present")
273
        unless ( defined $author );
274
 
275
    #
267 dpurdie 276
    #   Save the current workspace - with its modified build file
277
    #
278
    Verbose ("Apply new label to package: $tag_label");
279
    $session->SvnCopyWs (
1403 dpurdie 280
               'target'         => $session->BranchName($tag_label, 'tags' ),
281
               'modified'       => $opt_ofile,
2022 dpurdie 282
               'modifiedRoot'   => $sessionRoot,
1403 dpurdie 283
               'noswitch'       => 1,
284
               'replace'        => 0,
285
               'comment'        => 'Created by Jats SaveBuild',
286
               'noupdatecheck'  => 2,
267 dpurdie 287
               );
288
    Message ("Repository Ref: " . $session->RmRef);
1403 dpurdie 289
    Message ("Vcs Tag       : " . $session->SvnTag);
267 dpurdie 290
 
1329 dpurdie 291
    #
292
    #   Update the svn:author of the workspace rather than 'buildadm'
1403 dpurdie 293
    #   Allow badly configured repos. Don't fail if can't update the author
1329 dpurdie 294
    #
295
    Verbose ("Author: $author");
1403 dpurdie 296
    $session->setRepoProperty('svn:author', $author, 1);
1329 dpurdie 297
 
357 dpurdie 298
    if ( $opt_isa_wip )
267 dpurdie 299
    {
1403 dpurdie 300
        Verbose( 'Is a WIP');
301
        Verbose( '$session->WsType: ', $session->WsType);
302
        Verbose( '$opt_baselabel: ', $opt_baselabel);
267 dpurdie 303
        #
1403 dpurdie 304
        #   If the build is based on a WIP then we can delete the WIP
305
        #   tag under the following conditions:
306
        #       It is a true tag - and not a 'peg'
307
        #       It is a true WIP - and not a copy of another label
308
        #                          ie: Ends in .WIP - with possible peg
267 dpurdie 309
        #
1403 dpurdie 310
        if ( $opt_baselabel =~ m~(.+)::(.+)~ )
267 dpurdie 311
        {
1403 dpurdie 312
            my $baseTag = $2;
313
            if ( $baseTag =~ m~\.WIP(\@\d+)?$~)
314
            {
315
                $session->SvnDelete(
316
                        'target'  => $session->FullPath . '/tags/' . $baseTag,
317
                        'comment' => ["Deleted by Jats SaveBuild","Replaced by: $tag_label"],
318
                        'noerror' => 1,
319
                         );
320
            }
321
            else
322
            {
323
                Message ("WIP not deleted.","Will not delete WIPS of this type:" . $opt_baselabel );
324
            }
267 dpurdie 325
        }
326
        else
327
        {
1403 dpurdie 328
            Message ("WIP not deleted.","Cannot parse baselabel: " . $opt_baselabel );
267 dpurdie 329
        }
330
    }
331
 
332
    #
333
    #   Write the label out to the specified file so that the user
334
    #   can do something with it
335
    #
336
    if ( $opt_infofile )
337
    {
338
 
339
        my $data = JatsProperties::New();
340
 
341
        $data->setProperty('Label', $tag_label);
357 dpurdie 342
        $data->setProperty('WipLabel', $opt_baselabel) if $opt_isa_wip;
267 dpurdie 343
        $data->setProperty('PackageName', $opt_pname);
344
        $data->setProperty('PackageVersion', $opt_pversion);
345
        $data->setProperty('subversion.tag', $session->RmRef);
1403 dpurdie 346
        $data->setProperty('VCS.tag', 'SVN::' . $session->SvnTag);
267 dpurdie 347
 
348
        $data->Dump('InfoFile') if ($opt_verbose);
349
        $data->store( $opt_infofile );
350
    }
351
}
352
 
353
#-------------------------------------------------------------------------------
354
#   Documentation
355
#
356
 
357
=pod
358
 
361 dpurdie 359
=for htmltoc    SYSUTIL::
360
 
267 dpurdie 361
=head1 NAME
362
 
363
jats_svnsave_build - Save a build view to version control system
364
 
365
=head1 SYNOPSIS
366
 
367
  jats etool jats_save_build [options]
368
 
369
 Options:
370
    -help[=n]           - brief help message
371
    -help -help         - Detailed help message
372
    -man[=n]            - Full documentation
373
    -verbose[=n]        - Verbose operation
374
    -infile=xxx         - Input file (auto.pl)
375
    -outfile=xxx        - Output file (build.pl)
376
    -infofile=path      - Save label information in 'path'
377
    -pname=name         - Name of the package
378
    -pversion=text      - Package version
341 dpurdie 379
    -baselabel=text     - Base label for sandbox
353 dpurdie 380
    -isawip             - Current package is a WIP
267 dpurdie 381
 
382
=head1 OPTIONS
383
 
384
=over 8
385
 
386
=item B<-help[=n]>
387
 
388
Print a brief help message and exits.
389
 
390
The verbosity of the help text can be controlled by setting the help level to a
391
number in the range of 1 to 3, or by invoking the option multiple times.
392
 
393
=item B<-man[=n]>
394
 
395
Without a numeric argument this is the same as -help=3. Full help will be
396
displayed.
397
 
398
With a numeric argument, this option is the same as -help=n.
399
 
400
=item B<-verbose[=n]>
401
 
402
This option will increase the level of verbosity of the utility.
403
 
404
If an argument is provided, then it will be used to set the level, otherwise the
405
existing level will be incremented. This option may be specified multiple times.
406
 
407
=item B<-infile=xxxx>
408
 
409
This option specifies the name of the generated build configuration file that
410
will be used as a data-source for the check-in build file.
411
 
412
The default file name is 'auto.pl'.
413
 
414
=item B<-outfile=xxxx>
415
 
416
This option specifies the name of the target build configuration file that
417
will be checked in to version-control. Data from from file specifies with '-
418
infile' will be used to update the file.
419
 
420
The default file name is 'build.pl'.
421
 
422
=item B<-infofile=path>
423
 
424
This option specifies a file that this utility will use to communicate with a
425
user script. It will write the new label text into the file.
426
 
427
The file path is relative to the current working directory.
428
 
429
The file will be deleted, and only created if the utility is successful.
430
 
431
=item B<-pname=name>
432
 
433
This option specifies the package name. It will be used to construct a new
434
label for the package.
435
 
436
=item B<-pversion=xxx>
437
 
438
This option specifies the package version. It will be used to construct a new
439
label for the package.
440
 
353 dpurdie 441
=item B<-baselabel=text>
442
 
443
This option specifies the Version Control Label that the current workspace
444
is based on. This may be used to determine the new label for the package.
445
 
446
This parameter is mandatory.
447
 
448
=item B<-isawip>
449
 
267 dpurdie 450
This option controls the manner in which this utility will label the build view.
451
 
452
If present, the label specifies a 'Work In Progress' label. The label will be
453
renamed. At the end of the process the wip label will be deleted from the
454
the repository.
455
 
456
If not present, then the view will be labeled with a new label.
457
 
458
=back
459
 
460
=head1 DESCRIPTION
461
 
462
This utility is used by the automated build system to place build view under
463
version control. The utility will:
464
 
465
=over 8
466
 
361 dpurdie 467
=item *
267 dpurdie 468
 
361 dpurdie 469
Determine a suitable label for the package
470
 
267 dpurdie 471
The label is constructed from the package name and the package version. The
472
utility will ensure that the label does not already exist. If it does it will
473
use an alternate form of the label.
474
 
361 dpurdie 475
=item *
267 dpurdie 476
 
361 dpurdie 477
Locate the build files within the package
478
 
267 dpurdie 479
JATS build files do not need to be at the root of the package. The utility
480
will locate the JATS build files.
481
 
361 dpurdie 482
=item *
267 dpurdie 483
 
361 dpurdie 484
Update the build files and save them into the version control system
485
 
267 dpurdie 486
The build file will be updated with new version information as provided by a
487
secondary configuration file.
488
 
489
The updated file will be checked into version control.
490
 
361 dpurdie 491
=item *
267 dpurdie 492
 
361 dpurdie 493
Ensure that the package is labeled
494
 
267 dpurdie 495
The build view will be labeled (tagged).
496
 
497
If a WIP label is provided then the WIP label will be removed if it is a branch.
498
 
361 dpurdie 499
=item *
267 dpurdie 500
 
361 dpurdie 501
Return the label to the user
502
 
267 dpurdie 503
The label used to label the package will be returned to the user in an 'info'
504
file. This is a 'properties' file. The following properties are defined:
505
 
506
=over 8
507
 
361 dpurdie 508
=item 1
267 dpurdie 509
 
361 dpurdie 510
Label - The label used to tag the file
267 dpurdie 511
 
361 dpurdie 512
=item 2
267 dpurdie 513
 
361 dpurdie 514
PackageName - The package name
515
 
516
=item 3
517
 
518
PackageVersion - The package version
519
 
267 dpurdie 520
=back
521
 
522
=back
523
 
524
=cut
525