Subversion Repositories DevTools

Rev

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

Rev Author Line No. Line
407 dpurdie 1
########################################################################
2
# Copyright (C) 2007 ERG Limited, All rights reserved
3
#
4
# Module name   : jats.sh
5
# Module type   : Makefile system
6
# Compiler(s)   : n/a
7
# Environment(s): jats
8
#
9
# Description   : This program is invoked by the MakeDebianPackage
10
#                 directive, that is a part of this package
11
#
12
#                 The program will use a user-provided script in order
13
#                 to create a Debian Package.
14
#
15
#                 The user script may call a number of directives in order to
16
#                 construct an image of the package being installed.
17
#
18
#                 The script specifies Debian configuration scaripts that
19
#                 will be embedded in the package.
20
#
21
#                 This program will:
22
#                   Construct a filesystem image under control of the directives
23
#                   within the user script
24
#
25
#                   Massage the Debian control file
26
#
27
#                   Create a Debian Package
28
#
29
#                   Transfer it to the users 'BIN' directory, where it is
30
#                   available to be packaged.
31
#
32
#                 Summary of directives available to the user-script:
33
#                       AddInitScript           - Add an init script
34
#                       CatFile                 - Append to a file
35
#                       CopyDir                 - Copy directory tree
36
#                       CopyFile                - Copy a file
37
#                       CopyBinFile             - Copy an executable file
38
#                       CopyLibFile             - Copy a library file
39
#                       CreateDir               - Create a directory
40
#                       DebianFiles             - Specify control and script files
41
#                       EchoFile                - Place text into a file
42
#                       MakeSymLink             - Create a symbolic link
43
#                       PackageDescription      - Specify the package description
44
#                       SetFilePerms            - Set file permissions
45
#                       SetVerbose              - Control progress display
46
#                       IsProduct               - Flow control
47
#                       IsPlatform              - Flow control
48
#                       IsTarget                - Flow control
49
#
50
#                 Thoughts for expansion:
51
#                       ConvertFile             - Option to convert file(s) to Unix Text
52
#                       ReplaceTags             - Replace Tags on target file
53
#                       SrcDir                  - Extend path for resolving local files
54
#
55
#                   Less used:
56
#                        ExpandLinkFiles        - Expand .LINK files
57
#
58
#                   Internal Use:
59
#                        FindFiles              - Find a file
60
#                        ResolveFile            - Resolve a 'local' source file
61
#                        
62
#......................................................................#
63
 
411 dpurdie 64
require 5.006_001;
407 dpurdie 65
use strict;
66
use warnings;
67
 
68
use Getopt::Long;
69
use File::Path;
70
use File::Copy;
71
use File::Find;
72
use JatsSystem;
73
use FileUtils;
74
use JatsError;
75
use ReadBuildConfig;
76
 
77
#
78
#   Globals
79
#
80
my $DebianWorkDir;                          # Dir to create file system image within
81
 
82
#
83
#   Command line options
84
#
85
my $opt_debug   = $ENV{'GBE_DEBUG'};        # Allow global debug
86
my $opt_verbose = $ENV{'GBE_VERBOSE'};      # Allow global verbose
87
my $opt_vargs;                              # Verbose arg
88
my $opt_help = 0;
89
my $opt_manual = 0;
90
my $opt_clean = 0;
91
my $opt_platform;
92
my $opt_type;
93
my $opt_buildname;
94
my $opt_buildversion;
95
my $opt_interfacedir;
96
my $opt_target;
97
my $opt_product;
98
my $opt_package_script;
99
my $opt_interfaceincdir;
100
my $opt_interfacelibdir;
101
my $opt_interfacebindir;
102
my $opt_libdir;
103
my $opt_bindir;
104
my $opt_localincdir;
105
my $opt_locallibdir;
106
my $opt_localbindir;
107
my $opt_pkgdir;
108
my $opt_pkglibdir;
109
my $opt_pkgbindir;
110
my $opt_pkgpkgdir;
111
my $opt_output;
112
 
113
#
114
#   Options derived from script directives
115
#
116
my $opt_control = '';
117
my $opt_prerm = '';
118
my $opt_postrm = '';
119
my $opt_preinst = '';
120
my $opt_postinst = '';
121
my $opt_description;
122
 
415 dpurdie 123
#
124
#   Globals
125
#
126
my @ResolveFileList;                    # Cached Package File List
127
my @ResolveBinFileList;                 # Cached PackageBin File List
128
my @ResolveLibFileList;                 # Cached PackageLib File List
407 dpurdie 129
 
130
#-------------------------------------------------------------------------------
131
# Function        : Main Entry point
132
#
133
# Description     : This function will be called when the package is initialised
134
#                   Extract arguments from the users environment
135
#
136
#                   Done here to greatly simplify the user script
137
#                   There should be no junk in the user script - keep it simple
138
#
139
# Inputs          :
140
#
141
# Returns         : 
142
#
143
main();
144
sub main
145
{
146
    my $result = GetOptions (
147
                "verbose:s"         => \$opt_vargs,
148
                "clean"             => \$opt_clean,
149
                "Type=s"            => \$opt_type,
150
                "BuildName=s"       => \$opt_buildname,
151
                "BuildVersion=s"    => \$opt_buildversion,
152
                "Platform=s"        => \$opt_platform,
153
                "Target=s"          => \$opt_target,
154
                "Product=s"         => \$opt_product,
155
                "DebianPackage=s"   => \$opt_package_script,
156
                "InterfaceDir=s"    => \$opt_interfacedir,
157
                "InterfaceIncDir=s" => \$opt_interfaceincdir,
158
                "InterfaceLibDir=s" => \$opt_interfacelibdir,
159
                "InterfaceBinDir=s" => \$opt_interfacebindir,
160
                "LibDir=s"          => \$opt_libdir,
161
                "BinDir=s"          => \$opt_bindir,
162
                "LocalIncDir=s"     => \$opt_localincdir,
163
                "LocalLibDir=s"     => \$opt_locallibdir,
164
                "LocalBinDir=s"     => \$opt_localbindir,
165
                "PackageDir=s"      => \$opt_pkgdir,
166
                "PackageLibDir=s"   => \$opt_pkglibdir,
167
                "PackageBinDir=s"   => \$opt_pkgbindir,
168
                "PackagePkgDir=s"   => \$opt_pkgpkgdir,
169
                "Output=s"          => \$opt_output,
170
    );
171
 
172
    $opt_verbose++ unless ( $opt_vargs eq '@' );
173
 
174
    ErrorConfig( 'name'    => 'DebianUtils',
175
                 'verbose' => $opt_verbose,
176
                 'debug'   => $opt_debug );
177
 
178
    #
179
    #   Init the FileSystem Uiltity interface
180
    #
181
    InitFileUtils();
182
 
183
    #
184
    #   Ensure that we have all required options
185
    #
186
    Error ("Platform not set")                  unless ( $opt_platform );
187
    Error ("Type not set")                      unless ( $opt_type );
188
    Error ("BuildName not set")                 unless ( $opt_buildname );
189
    Error ("BuildVersion not set")              unless ( $opt_buildversion );
190
    Error ("InterfaceDir not set")              unless ( $opt_interfacedir );
191
    Error ("Target not set")                    unless ( $opt_target );
192
    Error ("Product not set")                   unless ( $opt_product );
193
    Error ("DebianPackage not set")             unless ( $opt_package_script );
194
    Error ("Ouput File not set")                unless ( $opt_output );
195
 
196
    #
197
    #   Clean up the build name
198
    #   Match any work done in the MakeDebianPackage directive
199
    #
200
    $opt_buildname =~ s~_~-~g;
201
 
202
    #
203
    #   Read in relevent config information
204
    #
205
    ReadBuildConfig ($opt_interfacedir, $opt_platform, '--NoTest' );
206
 
207
    #
208
    #   Build the package image in a directory based on the target being created
209
    #
210
    $DebianWorkDir = "$opt_platform$opt_type.image";
211
 
212
    #
213
    #   Configure the System command to fail on any error
214
    #
215
    SystemConfig ( ExitOnError => 1 );
216
 
217
    #
218
    #   Extract the 'name' of the package from the output path
219
    #   Display purposes only
220
    #
221
    my $DebianPkgName = StripDirExt($opt_output);
222
 
223
    #
224
    #   Display variables used
225
    #
226
    Message    "=Building Debian Package =============================================";
227
    Message    "Build $opt_buildname";
228
    Message    "       Package: $opt_buildname";
229
    Message    "       Version: $opt_buildversion";
230
    Message    "  Building for: $opt_platform, $opt_target";
231
    Message    "       Product: $opt_product";
232
    Message    "          Type: $opt_type";
233
    Verbose    "       Verbose: $opt_verbose";
234
    Verbose    "  InterfaceDir: $opt_interfacedir";
235
    Message    "       Package: $DebianPkgName";
236
    Message    "======================================================================";
237
 
238
    #
239
    #   Perform Clean up
240
    #   Invoked during "make clean" or "make clobber"
241
    #
242
    if ( $opt_clean )
243
    {
244
        Message ("Remove packaging directory: $DebianWorkDir");
245
        rmtree( $DebianWorkDir );
246
        rmtree ($opt_output) if ( -f $opt_output );
247
        exit;
248
    }
249
 
250
    #
251
    #   Clean  out the WORK directory
252
    #   Always start with a clean slate
253
    #
254
    #   Ensure that the base of the directory tree does not have 'setgid'
255
    #       This will upset the debian packager
256
    #       This may be an artifact from the users directory and not expected
257
    #
258
    rmtree( $DebianWorkDir );
259
    mkpath( $DebianWorkDir );
260
 
261
    my $perm = (stat $DebianWorkDir)[2] & 0777;
262
    chmod ( $perm & 0777, $DebianWorkDir );
263
 
264
    #
265
    #   Invoke the user script to do the hard work
266
    #
267
    do $opt_package_script;
268
 
269
    #
270
    #   Complete the building of the package
271
    #
272
    BuildDebianPackage ();
273
    Message ("Created Debian Package");
274
}
275
 
276
#-------------------------------------------------------------------------------
277
# Function        : BuildDebianPackage
278
#
279
# Description     : This function will create the Debian Package
280
#                   and transfer it to the target directory
281
#
282
# Inputs          : None
283
#
284
# Returns         : Nothing
285
#
286
sub BuildDebianPackage
287
{
288
    Error ("BuildDebianPackage: No Control File or Package Description")
289
        unless ( $opt_control || $opt_description );
290
 
291
    #
292
    #   Convert the FileSystem Image into a Debian Package
293
    #       Insert Debian control files
294
    #
295
    Verbose ("Copy in the Debian Control Files");
296
    mkdir ( "$DebianWorkDir/DEBIAN" );
297
 
298
    CopyFile ( $opt_prerm,    "/DEBIAN", "prerm" )    if $opt_prerm;
299
    CopyFile ( $opt_postrm,   "/DEBIAN", "postrm" )   if $opt_postrm;
300
    CopyFile ( $opt_preinst,  "/DEBIAN", "preinst" )  if $opt_preinst;
301
    CopyFile ( $opt_postinst, "/DEBIAN", "postinst" ) if $opt_postinst;
302
 
303
    UpdateControlFile ($opt_control );
304
    System ( 'chmod', '-R', 'a+rx', "$DebianWorkDir/DEBIAN" );
305
    System ( 'build_dpkg.sh', '-b', $DebianWorkDir);
306
    System ( 'mv', '-f', "$DebianWorkDir.deb", $opt_output );
307
 
308
    System ("build_dpkg.sh", '-I', $opt_output) if (IsVerbose(1));
309
 
310
}
311
 
312
#-------------------------------------------------------------------------------
313
# Function        : UpdateControlFile
314
#
315
# Description     : Update the Debian 'control' file to fix up varoius fields
316
#                   within the file.
317
#
318
#                   If the files has not been specified, then a basic control
319
#                   file will be provided.
320
#
321
#                   This routine knows where the control file will be placed
322
#                   within the output work space.
323
#
324
# Inputs          : $src            - Path to source file
325
#                   Uses global variables
326
#
327
# Returns         : Nothing
328
#
329
sub UpdateControlFile
330
{
331
    my($src) = @_;
332
    my $dst = "$DebianWorkDir/DEBIAN/control";
333
 
334
    unless ( $src )
335
    {
336
        CreateControlFile();
337
        return;
338
    }
339
 
340
    Verbose ("UpdateControlFile: $dst" );
341
    $src = ResolveFile( 0, $src );
342
 
343
    open (SF, '<', $src) || Error ("UpdateControlFile: Cannot open $src");
344
    open (DF, '>', $dst) || Error ("UpdateControlFile: Cannot create:$dst");
345
    while ( <SF> )
346
    {
347
        s~\s*$~~;
348
        if ( m~^Package:~ ) {
349
            $_ = "Package: $opt_buildname";
350
 
351
        } elsif ( m~^Version:~ ) {
352
            $_ = "Version: $opt_buildversion";
353
 
354
        } elsif ( m~^Architecture:~ ) {
355
            $_ = "Architecture: $opt_platform";
356
 
357
        } elsif ( $opt_description && m~^Description:~ ) {
358
            $_ = "Description: $opt_description";
359
        }
360
        print DF $_ , "\n";
361
    }
362
    close (SF);
363
    close (DF);
364
}
365
 
366
#-------------------------------------------------------------------------------
367
# Function        : CreateControlFile
368
#
369
# Description     : Craete a basic debian control file
370
#
371
# Inputs          : Uses global variables
372
#
373
# Returns         : 
374
#
375
sub CreateControlFile
376
{
377
    my $dst = "$DebianWorkDir/DEBIAN/control";
378
 
379
    Verbose ("CreateControlFile: $dst" );
380
 
381
    open (DF, '>', $dst) || Error ("CreateControlFile: Cannot create:$dst");
382
    print DF "Package: $opt_buildname\n";
383
    print DF "Version: $opt_buildversion\n";
384
    print DF "Section: main\n";
385
    print DF "Priority: standard\n";
386
    print DF "Architecture: $opt_platform\n";
387
    print DF "Essential: yes\n";
388
    print DF "Maintainer: ERG\n";
389
    print DF "Description: $opt_description\n";
390
    close (DF);
391
}
392
 
393
#-------------------------------------------------------------------------------
394
# Function        : SetVerbose
395
#
396
# Description     : Set the level of verbosity
397
#                   Display activity
398
#
399
# Inputs          : Verbosity level
400
#                       0 - Use makefile verbosity (Default)
401
#                       1..2
402
#
403
# Returns         : 
404
#
405
sub SetVerbose
406
{
407
    my ($level) = @_;
408
 
409
    $level = $opt_verbose unless ( $level );
410
    $opt_verbose = $level;
411
    ErrorConfig( 'verbose' => $level);
412
}
413
 
414
 
415
#-------------------------------------------------------------------------------
416
# Function        : DebianFiles
417
#
418
# Description     : Name Debian builder control files
419
#                   May be called multiple times
420
#
421
# Inputs          : Options
422
#                       --Control=file
423
#                       --PreRm=file
424
#                       --PostRm=file
425
#                       --PreInst=file
426
#                       --PostInst=file
427
#
428
# Returns         : Nothing
429
#
430
sub DebianFiles
431
{
432
    #
433
    #   Exctact names
434
    #
435
    Verbose ("Specify Debian Control Files and Scripts");
436
    foreach  ( @_ )
437
    {
438
        if ( m/^--Control=(.+)/ ) {
439
            $opt_control = $1;
440
 
441
        } elsif ( m/^--PreRm=(.+)/ ) {
442
            $opt_prerm = $1;
443
 
444
        } elsif ( m/^--PostRm=(.+)/ ) {
445
            $opt_postrm = $1;
446
 
447
        } elsif ( m/^--PreInst=(.+)/ ) {
448
            $opt_preinst  = $1;
449
 
450
        } elsif ( m/^--PostInst=(.+)/ ) {
451
            $opt_postinst = $1;
452
 
453
        } else {
454
            Error ("DebianFiles: Unknown option: $_");
455
        }
456
    }
457
}
458
 
459
#-------------------------------------------------------------------------------
460
# Function        : PackageDescription
461
#
462
# Description     : Specify the Package Description
463
#                   Keep it short
464
#
465
# Inputs          : $description
466
#
467
# Returns         : 
468
#
469
sub PackageDescription
470
{
471
    ($opt_description) = @_;
472
}
473
 
474
#-------------------------------------------------------------------------------
475
# Function        : MakeSymLink
476
#
477
# Description     : Create a symlink - with error detection
478
#
479
# Inputs          : old_file    - Link Target
480
#                                 Path to the link target
481
#                                 If an ABS path is provided, the routine will
482
#                                 attempt to create a relative link.
483
#                   new_file    - Relative to the output work space
484
#                                 Path to where the 'link' file will be created
485
#                   Options     - Must be last
486
#                                 --NoClean         - Don't play with links
487
#                                 --NoDotDot        - Don't create symlinks with ..
488
#
489
# Returns         : Nothing
490
#
491
sub MakeSymLink
492
{
493
    my $no_clean;
494
    my $no_dot;
495
    my @args;
496
 
497
    #
498
    #   Extract options
499
    #
500
    foreach ( @_ )
501
    {
502
        if ( m/^--NoClean/i ) {
503
            $no_clean = 1;
504
 
505
        } elsif ( m/^--NoDotDot/i ) {
506
            $no_dot = 1;
507
 
508
        } elsif ( m/^--/ ) {
509
            Error ("MakeSymLink: Unknown option: $_");
510
 
511
        } else {
512
            push @args, $_;
513
        }
514
    }
515
 
516
    my ($old_file, $new_file) = @args;
517
 
518
    my $tfile = $DebianWorkDir . '/' . $new_file;
519
    $tfile =~ s~//~/~;
520
    Verbose ("Symlink $old_file -> $new_file" );
521
 
522
    #
523
    #   Create the directory in which the link will be placed
524
    #   Remove any existing file of the same name
525
    #
526
    my $dir = StripFileExt( $tfile );
527
    mkpath( $dir) unless -d $dir;
528
    unlink $tfile;
529
 
530
    #
531
    #   Determine a good name of the link
532
    #   Convert to a relative link in an attempt to prune them
533
    #
534
    my $sfile = $old_file;
535
    unless ( $no_clean )
536
    {
537
        $sfile = CalcRelPath( StripFileExt( $new_file ), $old_file );
538
        $sfile = $old_file if ( $no_dot && $sfile =~ m~^../~ );
539
    }
540
 
541
    my $result = symlink $sfile, $tfile;
542
    Error ("Cannot create symlink. $old_file -> $new_file") unless ( $result );
543
}
544
 
545
#-------------------------------------------------------------------------------
546
# Function        : CopyFile
547
#
548
# Description     : Copy a file to a target dir
549
#                   Used for text files, or files with fixed names
550
#
551
# Inputs          : $src
552
#                   $dst_dir    - Within the output workspace
553
#                   $dst_name   - Output Name [Optional]
554
#                   Options     - Common Copy Options
555
#
556
# Returns         : Full path to destination file
557
#
558
sub CopyFile
559
{
560
    CopyFileCommon( \&ResolveFile, @_ );
561
}
562
 
563
#-------------------------------------------------------------------------------
564
# Function        : CopyBinFile
565
#
566
# Description     : Copy a file to a target dir
567
#                   Used for executable programs. Will look in places where
568
#                   programs are stored.
569
#
570
# Inputs          : $src
571
#                   $dst_dir    - Within the output workspace
572
#                   $dst_name   - Output Name [Optional]
573
#
574
#                   Options:
575
#                       --FromPackage
576
#                       --SoftLink=xxxx
577
#                       --LinkFile=xxxx
578
#
579
#
580
# Returns         : Full path to destination file
581
#
582
sub CopyBinFile
583
{
584
    CopyFileCommon( \&ResolveBinFile, @_ );
585
}
586
 
587
#-------------------------------------------------------------------------------
588
# Function        : CopyLibFile
589
#
590
# Description     : Copy a file to a target dir
591
#                   Used for shared programs. Will look in places where
592
#                   shared libraries are stored.
593
#
594
# Inputs          : $src        - Base for 'realname' (no lib, no extension)
595
#                   $dst_dir    - Within the output workspace
596
#                   $dst_name   - Output Name [Optional, but not suggested]
597
#
598
# Returns         : Full path to destination file
599
#
600
# Notes           : Copying 'lib' files
601
#                   These are 'shared libaries. There is no provision for copying
602
#                   static libraries.
603
#
604
#                   The tool will attempt to copy a well-formed 'realname' library
605
#                   The soname of the library should be constructed on the target
606
#                   platform using ldconfig.
607
#                   There is no provision to copy the 'linker' name
608
#
609
#                   Given a request to copy a library called 'fred', then the
610
#                   well formed 'realname' will be:
611
#                           libfred[P|D|]].so.nnnnn
612
#                   where:
613
#                           nnnn is the library version
614
#                           [P|D|] indicates Production, Debug or None
615
#
616
#                   The 'soname' is held within the realname form of the library
617
#                   and will be created by lsconfig.
618
#
619
#                   The 'linkername' would be libfred[P|D|].so. This is only
620
#                   needed when linking against the library.
621
#
622
#
623
#                   The routine will also recognize Windows DLLs
624
#                   These are of the form fred[P|D|].nnnnn.dll
625
#
626
sub CopyLibFile
627
{
628
    CopyFileCommon( \&ResolveLibFile, @_ );
629
}
630
 
631
#-------------------------------------------------------------------------------
632
# Function        : CopyFileCommon
633
#
634
# Description     : Common ( internal File Copy )
635
#
636
# Inputs          : $resolver           - Ref to function to resolve source file
637
#                   $src                - Source File Name
638
#                   $dst_dir            - Target Dir
639
#                   $dst_name           - Target Name (optional)
640
#                   Options
641
#                   Options:
642
#                       --FromPackage
643
#                       --SoftLink=xxxx
644
#                       --LinkFile=xxxx
645
#
646
# Returns         : 
647
#
648
sub CopyFileCommon
649
{
650
    my $from_package = 0;
651
    my $isa_linkfile = 0;
652
    my @llist;
653
    my @args;
654
 
655
    #
656
    #   Parse options
657
    #
658
    foreach ( @_ )
659
    {
660
        if ( m/^--FromPackage/ ) {
661
            $from_package = 1;
662
 
663
        } elsif ( m/^--LinkFile/ ) {
664
            $isa_linkfile = 1;
665
 
666
        } elsif ( m/^--SoftLink=(.+)/ ) {
667
            push @llist, $1;
668
 
669
        } elsif ( m/^--/ ) {
670
            Error ("FileCopy: Unknown option: $_");
671
 
672
        } else {
673
            push @args, $_;
674
        }
675
    }
676
 
677
    #
678
    #   Extract non-options.
679
    #   These are the bits that are left over
680
    #
681
    my ($resolver, $src, $dst_dir, $dst_name ) = @args;
682
 
683
    #
684
    #   Clean up dest_dir. Must start with a / and not end with one
685
    #
686
    $dst_dir = "/$dst_dir/";
687
    $dst_dir =~ s~/+~/~g;
688
    $dst_dir =~ s~/$~~;
689
 
690
    Verbose ("CopyFile: $src, $dst_dir, " . ($dst_name || ''));
691
    foreach $src ( &$resolver( $from_package, $src ) )
692
    {
693
        my $dst_fname = $dst_name ? $dst_name : StripDir($src);
694
        my $dst_file = "$dst_dir/$dst_fname";
695
        Verbose ("CopyFile: Copy $src, $dst_file" );
696
 
697
 
698
        #
699
        #   LinkFiles are special
700
        #   They get concatenated to any existing LINKS File
701
        #
702
        if ( $isa_linkfile )
703
        {
704
            CatFile ( $src, "$dst_dir/.LINKS" );
705
        }
706
        else
707
        {
708
            mkpath( "$DebianWorkDir$dst_dir", 0, 0775);
709
            unlink ("$DebianWorkDir$dst_file");
710
            System ('cp','-f', $src, "$DebianWorkDir$dst_file" );
711
 
712
            foreach my $lname ( @llist )
713
            {
714
                $lname = $dst_dir . '/' . $lname unless ( $lname =~ m ~^/~ );
715
                MakeSymLink( $dst_file ,$lname);
716
            }
717
        }
718
    }
719
}
720
 
721
#-------------------------------------------------------------------------------
722
# Function        : CopyDir
723
#
724
# Description     : Copy a directory to a target dir
725
#
726
# Inputs          : $src_dir    - Local to the user
727
#                                 Symbolic Name
728
#                   $dst_dir    - Within the output workspace
729
#                   Options
730
#                       --Merge
731
#                       --
732
#
733
# Returns         :
734
#
735
sub CopyDir
736
{
737
    my ($src_dir, $dst_dir, @opts) = @_;
738
    my $opt_merge;
739
    my $opt_base;
411 dpurdie 740
    my $from_interface = 0;
407 dpurdie 741
 
742
    $dst_dir = $DebianWorkDir . '/' . $dst_dir;
743
    $dst_dir =~ s~//~/~;
744
 
745
    #
746
    #   Detect and expand Symbolic names in the Source Directory
747
    #
748
    foreach  ( @opts )
749
    {
750
        if ( m/^--Merge/ ) {
751
            $opt_merge = 1;
752
        } elsif ( m/^--Source=(.+)/ ) {
753
            my $name = lc($1);
754
            my %CopyDirSymbolic = (
755
                'interfaceincdir'   => $opt_interfaceincdir,
756
                'interfacelibdir'   => $opt_interfacelibdir,
757
                'interfacebindir'   => $opt_interfacebindir,
758
                'libdir'            => $opt_libdir,
759
                'bindir'            => $opt_bindir,
760
                'localincdir'       => $opt_localincdir,
761
                'locallibdir'       => $opt_locallibdir,
762
                'localbindir'       => $opt_localbindir,
763
                'packagebindir'     => $opt_pkgbindir,
764
                'packagelibdir'     => $opt_pkglibdir,
765
                'packagepkgdir'     => $opt_pkgpkgdir,
766
                'packagedir'        => $opt_pkgdir,
767
            );
768
 
769
            if ( exists $CopyDirSymbolic{$name} )
770
            {
771
                $opt_base = $CopyDirSymbolic{$name};
411 dpurdie 772
 
773
                #
774
                #   If sourceing from interface, then follow
775
                #   symlinks in the copy. All files will be links anyway
776
                #
777
                $from_interface = 1
778
                    if ( $name =~ m~^interface~ );
407 dpurdie 779
            }
780
            else
781
            {
782
                DebugDumpData ("CopyDirSymbolic", \%CopyDirSymbolic);
783
                Error ("CopyDir: Unknown Source Name: $name" );
784
            }
785
        } else {
786
            Error ("CopyDir: Unknown option: $_" );
787
        }
788
    }
789
 
790
    $src_dir = $opt_base . '/' . $src_dir if ( $opt_base );
791
    $src_dir =~ s~//~/~g;
792
    $src_dir =~ s~/$~~;
793
 
794
    Verbose ("CopyDir: $src_dir, $dst_dir");
795
    Error ("CopyDir: Directory not found: $src_dir") unless ( -d $src_dir );
796
 
797
    #
798
    #   If not merging then delete the target before copying
799
    #
800
    rmtree( $dst_dir ) unless $opt_merge;
411 dpurdie 801
    mkpath ( $dst_dir );
407 dpurdie 802
 
803
    my $cpflags = '-r';
411 dpurdie 804
    $cpflags .= 'L' if ( $from_interface );
407 dpurdie 805
    $cpflags .= 'v' if ( $opt_verbose > 1 );
806
 
807
    #
808
    #   Determine the complete list of source files
809
    #   Need to allow for files begining with a .
810
    #
811
    opendir (DIR, $src_dir ) || Error ("CopyDir: Can't read directory: $src_dir");
812
    my @files = readdir(DIR);
813
    closedir(DIR);
814
 
815
    foreach ( @files  )
816
    {
817
        next if ( $_ eq '.' );
818
        next if ( $_ eq '..' );
411 dpurdie 819
        next if ( $_ eq '.svn' );
407 dpurdie 820
        System ('cp', $cpflags, "$src_dir/$_", $dst_dir );
821
    }
822
    #
823
    #   Expand link files that may have been copied in
824
    #
825
    Verbose ("Locate LINKFILES in $DebianWorkDir");
826
    ExpandLinkFiles();
827
}
828
 
829
#-------------------------------------------------------------------------------
830
# Function        : AddInitScript
831
#
832
# Description     : Add an Init Script to the target
833
#                   Optionally create start and stop links
834
#
835
# Inputs          : $script     - Name of the init script
836
#                   $start      - Start Number
837
#                   $stop       - Stop Number
838
#                   Options:
839
#                       --NoCopy        - Don't copy the script, just add links
840
#                       --Afc           - Place in AFC init area
841
#                       --FromPackage   - Source is in a package
842
#
843
# Returns         : 
844
#
845
sub AddInitScript
846
{
847
    my $no_copy;
848
    my $basedir = "";
849
    my @args;
850
    my $from_package = 0;
851
 
852
    #
853
    #   Process and Remove options
854
    #
855
    foreach  ( @_ )
856
    {
857
        if ( m/^--NoCopy/ ) {
858
            $no_copy = 1;
859
 
860
        } elsif ( m/^--Afc/ ) {
861
            $basedir = "/afc";
862
 
863
        } elsif ( m/^--FromPackage/ ) {
864
            $from_package = 1;
865
 
866
        } elsif ( m/^--/ ) {
867
            Error ("AddInitScript: Unknown option: $_");
868
 
869
        } else {
870
            push @args, $_;
871
 
872
        }
873
    }
874
 
875
    my( $script, $start, $stop ) = @args;
876
    Error ("No script file specified") unless ( $script );
877
    Warning("AddInitScript: No start or stop index specified") unless ( $start || $stop );
878
    Verbose ("AddInitScript: $script, " . ($start || 'No Start') . ", " . ($stop || 'No Stop'));
879
    $script = ResolveFile($from_package, $script );
880
 
881
    my $tdir = $basedir . "/etc/init.d/init.d";
882
    my $base = StripDir($script);
883
 
884
    CopyFile( $script, $tdir ) unless $no_copy;
885
 
886
    my $link;
887
    if ( $start )
888
    {
889
        $link = sprintf ("${basedir}/etc/init.d/S%2.2d%s", $start, $base );
890
        MakeSymLink( "$tdir/$base", $link);
891
    }
892
 
893
    if ( $stop )
894
    {
895
        $link = sprintf ("${basedir}/etc/init.d/K%2.2d%s", $stop, $base );
896
        MakeSymLink( "$tdir/$base", $link);
897
    }
898
}
899
 
900
#-------------------------------------------------------------------------------
901
# Function        : CatFile
902
#
903
# Description     : Copy a file to the end of a file
904
#
905
# Inputs          : $src
906
#                   $dst    - Within the output workspace
907
#
908
# Returns         :
909
#
910
sub CatFile
911
{
912
    my ($src, $dst) = @_;
913
 
914
    $dst = $DebianWorkDir . '/' . $dst;
915
    $dst =~ s~//~/~;
916
    Verbose ("CatFile: $src, $dst");
917
    $src = ResolveFile(0, $src );
918
 
919
    open (SF, '<', $src)  || Error ("CatFile: Cannot open $src");
920
    open (DF, '>>', $dst) || Error ("CatFile: Cannot create:$dst");
921
    while ( <SF> )
922
    {
923
        print DF $_;
924
    }
925
    close (SF);
926
    close (DF);
927
}
928
 
929
#-------------------------------------------------------------------------------
930
# Function        : EchoFile
931
#
932
# Description     : Echo simple text to a file
933
#
934
# Inputs          : $file   - Within the output workspace
935
#                   $text
936
#
937
# Returns         : 
938
#
939
sub EchoFile
940
{
941
    my ($file, $text) = @_;
942
    Verbose ("EchoFile: $file");
943
 
944
    $file = $DebianWorkDir . '/' . $file;
945
    $file =~ s~//~/~;
946
 
947
    unlink $file;
948
    open (DT, ">", $file ) || Error ("Cannot create $file");
949
    print DT  $text || Error ("Cannot print to $file");
950
    close DT;
951
}
952
 
953
#-------------------------------------------------------------------------------
954
# Function        : SetFilePerms
955
#
956
# Description     : Set file permissions on one or more files or directories
957
#
958
# Inputs          : $perm           - Perm Mask
959
#                   @paths          - List of paths/files to process
960
#                   Options
961
#                       --Recurse   - Recurse subdirs
962
#
963
# Returns         : 
964
#
965
sub SetFilePerms
966
{
967
 
968
    my @args;
969
    my $perms;
970
    my $recurse = 0;
971
 
972
    #
973
    #   Process and Remove options
974
    #
975
    foreach  ( @_ )
976
    {
977
        if ( m/^--Recurse/ ) {
978
            $recurse = 1;
979
 
980
        } elsif ( m/^--/ ) {
981
            Error ("SetFilePerms: Unknown option: $_");
982
 
983
        } else {
984
            push @args, $_;
985
 
986
        }
987
    }
988
 
989
    $perms = shift @args;
990
    Error ("SetFilePerms: No Permissions" ) unless ( $perms );
991
 
992
    foreach my $path ( @args )
993
    {
994
        Verbose ("Set permissions; $perms, $path");
995
        my $full_path = $DebianWorkDir . '/' . $path;
996
        if ( -f $full_path )
997
        {
998
            System ('chmod', $perms, $full_path );
999
        }
1000
        elsif ( -d $full_path )
1001
        {
1002
            System ('chmod', '-R', $perms, $full_path ) if ($recurse);
1003
            System ('chmod', $perms, $full_path ) unless ($recurse);
1004
        }
1005
        else
1006
        {
1007
            Warning("SetFilePerms: Path not found: $path");
1008
        }
1009
    }
1010
}
1011
 
1012
#-------------------------------------------------------------------------------
1013
# Function        : CreateDir
1014
#
1015
# Description     : Create a directory within the target workspace
1016
#
1017
# Inputs          : $path           - Name of the target directory
1018
#
1019
# Returns         : Nothing
1020
#
1021
sub CreateDir
1022
{
1023
    my ($path) = @_;
1024
 
1025
    Verbose ("Create Dir: $path");
1026
    mkpath( $DebianWorkDir . '/' . $path );
1027
}
1028
 
1029
#-------------------------------------------------------------------------------
1030
# Function        : IsProduct
1031
#                   IsPlatform
1032
#                   IsTarget
1033
#
1034
# Description     : This function allows some level of control in the
1035
#                   packaging scripts. It will return true if the current
1036
#                   product is listed.
1037
#
1038
#                   Ugly after thought
1039
#
1040
#                   Intended use:
1041
#                       Xxxxxx(...) if (IsProduct( 'aaa',bbb' );
1042
#
1043
# Inputs          : products    - a list of products to compare against
1044
#
1045
# Returns         : True if the current build is for one of the listed products
1046
#
1047
sub IsProduct
1048
{
1049
    foreach ( @_ )
1050
    {
1051
        return 1 if ( $opt_product eq $_ );
1052
    }
1053
    return 0;
1054
}
1055
 
1056
sub IsPlatform
1057
{
1058
    foreach ( @_ )
1059
    {
1060
        return 1 if ( $opt_platform eq $_ );
1061
    }
1062
    return 0;
1063
}
1064
 
1065
sub IsTarget
1066
{
1067
    foreach ( @_ )
1068
    {
1069
        return 1 if ( $opt_target eq $_ );
1070
    }
1071
    return 0;
1072
}
1073
 
1074
 
1075
#-------------------------------------------------------------------------------
1076
# Function        : FindFiles
1077
#
1078
# Description     : Locate files within a given dir tree
1079
#
1080
# Inputs          : $root           - Base of the search
1081
#                   $match          - Re to match
1082
#
1083
# Returns         : A list of files that match
1084
#
1085
my @FIND_LIST;
1086
my $FIND_NAME;
1087
 
1088
sub FindFiles
1089
{
1090
    my ($root, $match ) = @_;
1091
    Verbose2("FindFiles: Root: $root, Match: $match");
1092
 
1093
    #
1094
    #   Becareful of closure, Must use globals
1095
    #
1096
    @FIND_LIST = ();
1097
    $FIND_NAME = $match;
1098
    File::Find::find( \&find_files, $root);
1099
 
1100
    #
1101
    #   Find callback program
1102
    #
1103
    sub find_files
1104
    {
1105
        my $item =  $File::Find::name;
1106
 
1107
        return if ( -d $File::Find::name );
1108
        return unless ( $_ =~ m~$FIND_NAME~ );
1109
        push @FIND_LIST, $item;
1110
    }
1111
    return @FIND_LIST;
1112
}
1113
 
1114
#-------------------------------------------------------------------------------
1115
# Function        : CalcRelPath
1116
#
1117
# Description     : Return the relative path to the current working directory
1118
#                   as provided in $Cwd
1119
#
1120
# Inputs          : $Cwd - Base dir
1121
#                   $base - Path to convert
1122
#
1123
# Returns         : Relative path from the $Cwd
1124
#
1125
sub CalcRelPath
1126
{
1127
    my ($Cwd, $base) = @_;
1128
 
1129
    my @base = split ('/', $base );
1130
    my @here = split ('/', $Cwd );
1131
    my $result;
1132
 
1133
    Debug("RelPath: Source: $base");
1134
 
1135
    return $base unless ( $base =~ m~^/~ );
1136
 
1137
    #
1138
    #   Remove common bits from the head of both lists
1139
    #
1140
    while ( $#base >= 0 && $#here >= 0 && $base[0] eq $here[0] )
1141
    {
1142
        shift @base;
1143
        shift @here;
1144
    }
1145
 
1146
    #
1147
    #   Need to go up some directories from here and then down into base
1148
    #
1149
    $result = '../' x ($#here + 1);
1150
    $result .= join ( '/', @base);
1151
    $result = '.' unless ( $result );
1152
    $result =~ s~//~/~g;
1153
    $result =~ s~/$~~;
1154
 
1155
    Debug("RelPath: Result: $result");
1156
    return $result;
1157
}
1158
 
1159
#-------------------------------------------------------------------------------
1160
# Function        : ExpandLinkFiles
1161
#
1162
# Description     : Look for .LINK files in the output image and expand
1163
#                   the links into softlinks
1164
#
1165
# Inputs          : None
1166
#                   The rouine works on the $DebianWorkDir directory tree
1167
#
1168
# Returns         : Nothing
1169
#                   Will remove .LINKS files that are processed
1170
#
1171
sub ExpandLinkFiles
1172
{
1173
    foreach my $linkfile ( FindFiles( $DebianWorkDir, ".LINKS" ))
1174
    {
1175
        next if ( $linkfile =~ m~/\.svn/~ );
1176
        my $BASEDIR = StripFileExt( $linkfile );
1177
        $BASEDIR =~ s~^$DebianWorkDir/~~;
1178
        Verbose "Expand links: $BASEDIR";
1179
 
1180
        open (LF, "<", $linkfile ) || Error ("Cannot open link file: $linkfile" );
1181
        while ( <LF> )
1182
        {
1183
            chomp;
1184
            next if ( m~^#~ );
1185
            next unless ( $_ );
1186
            my ($link, $file) = split;
1187
 
1188
            MakeSymLink($file ,"$BASEDIR/$link", '--NoDotDot' );
1189
        }
1190
        close (LF);
1191
        unlink $linkfile;
1192
    }
1193
}
1194
 
1195
#-------------------------------------------------------------------------------
1196
# Function        : ResolveFile
1197
#
1198
# Description     : Determine where the source for a file is
415 dpurdie 1199
#                   Will look in (default):
407 dpurdie 1200
#                       Local directory
1201
#                       Local Include
415 dpurdie 1202
#                   Or  (FromPackage)
1203
#                       Our Package directory
1204
#                       Interface directory (BuildPkgArchives)
1205
#                       Packages (LinkPkgArchive)
1206
#
407 dpurdie 1207
#                   Will scan 'parts' subdirs
1208
#
1209
# Inputs          : $from_package       - 0 - Local File
1210
#                   $file
1211
#
1212
# Returns         : Path
1213
#
1214
sub ResolveFile
1215
{
1216
    my ($from_package, $file) = @_;
1217
    my $wildcard = ($file =~ /[*?]/);
415 dpurdie 1218
    my @path;
407 dpurdie 1219
 
1220
    #
415 dpurdie 1221
    #   Determine the paths to search
1222
    #
1223
    if ( $from_package )
1224
    {
1225
        unless ( @ResolveFileList )
1226
        {
1227
            push @ResolveFileList, $opt_pkgdir;
1228
            foreach my $entry ( getPackageList() )
1229
            {
1230
                push @ResolveFileList, $entry->getBase(3);
1231
            }
1232
        }
1233
        @path = @ResolveFileList;
1234
    }
1235
    else
1236
    {
1237
        @path = ('.', $opt_localincdir);
1238
    }
1239
 
1240
    #
407 dpurdie 1241
    #   Determine a full list of 'parts' to search
1242
    #   This is provided within the build information
1243
    #
1244
    my @parts = getPlatformParts ();
1245
    push @parts, '';
1246
 
1247
    my @done;
1248
    foreach my $root (  @path )
1249
    {
1250
        foreach my $subdir ( @parts )
1251
        {
1252
            my $sfile;
415 dpurdie 1253
            $sfile = "$root/$subdir/$file";
1254
            $sfile =~ s~//~/~g;
1255
            $sfile =~ s~^./~~g;
1256
            Verbose2("LocateFile: $sfile, $root, $subdir");
1257
            if ( $wildcard )
1258
            {
1259
                push @done, glob ( $sfile );
1260
            }
1261
            else
1262
            {
1263
                push @done, $sfile if ( -f $sfile || -l $sfile )
1264
            }
407 dpurdie 1265
        }
1266
    }
1267
 
415 dpurdie 1268
    Error ("ResolveFile: File not found: $file", "Search Path:", @path)
407 dpurdie 1269
        unless ( @done );
1270
 
1271
    Warning ("ResolveFile: Multiple instances of file found. Only first is used", @done)
1272
        if ( $#done > 0 && ! $wildcard && !wantarray );
1273
 
1274
    return wantarray ? @done : $done[0];
1275
}
1276
 
1277
#-------------------------------------------------------------------------------
1278
# Function        : ResolveBinFile
1279
#
415 dpurdie 1280
# Description     : Determine where the source for a BIN file is
1281
#                   Will look in (default):
1282
#                       Local directory
1283
#                       Local Include
1284
#                   Or  (FromPackage)
1285
#                       Our Package directory
1286
#                       Interface directory (BuildPkgArchives)
1287
#                       Packages (LinkPkgArchive)
407 dpurdie 1288
#                   Will scan 'parts' subdirs
1289
#
1290
# Inputs          : $from_package       - 0 - Local File
415 dpurdie 1291
#                   $file
407 dpurdie 1292
#
1293
# Returns         : Path
1294
#
1295
sub ResolveBinFile
1296
{
1297
    my ($from_package, $file) = @_;
1298
    my @path;
1299
    my @types;
1300
    my $wildcard = ($file =~ /[*?]/);
1301
 
415 dpurdie 1302
    #
1303
    #   Determine the paths to search
1304
    #
407 dpurdie 1305
    if ( $from_package )
1306
    {
415 dpurdie 1307
        unless ( @ResolveBinFileList )
1308
        {
1309
            push @ResolveBinFileList, $opt_pkgdir . '/bin';
1310
            foreach my $entry ( getPackageList() )
1311
            {
1312
                if ( my $path = $entry->getBase(3) )
1313
                {
1314
                    $path .= '/bin';
1315
                    push @ResolveBinFileList, $path if ( -d $path );
1316
                }
1317
            }
1318
        }
1319
        @path = @ResolveBinFileList;
407 dpurdie 1320
        @types = ($opt_type, '');
1321
    }
1322
    else
1323
    {
1324
        @path = ($opt_bindir, $opt_localbindir);
1325
        @types = '';
1326
    }
1327
 
1328
    #
1329
    #   Determine a full list of 'parts' to search
1330
    #   This is provided within the build information
1331
    #
1332
    my @parts = getPlatformParts ();
1333
    push @parts, '';
1334
 
1335
    my @done;
1336
    foreach my $root (  @path )
1337
    {
1338
        foreach my $subdir ( @parts )
1339
        {
1340
            foreach my $type ( @types )
1341
            {
1342
                my $sfile;
1343
                $sfile = "$root/$subdir$type/$file";
1344
                $sfile =~ s~//~/~g;
1345
                Verbose2("LocateBinFile: $sfile");
1346
                if ( $wildcard )
1347
                {
1348
                    push @done, glob ( $sfile );
1349
                }
1350
                else
1351
                {
415 dpurdie 1352
                    push @done, $sfile if ( -f $sfile || -l $sfile )
407 dpurdie 1353
                }
1354
            }
1355
        }
1356
    }
1357
 
415 dpurdie 1358
    Error ("ResolveBinFile: File not found: $file", "Search Path:", @path)
407 dpurdie 1359
        unless ( @done );
1360
 
1361
    Warning ("ResolveBinFile: Multiple instances of file found. Only first is used", @done)
1362
        if ( $#done > 0 && ! $wildcard && !wantarray );
1363
    return wantarray ? @done : $done[0];
1364
}
1365
 
1366
#-------------------------------------------------------------------------------
1367
# Function        : ResolveLibFile
1368
#
415 dpurdie 1369
# Description     : Determine where the source for a LIB file is
1370
#                   Will look in (default):
1371
#                       Local directory
1372
#                       Local Include
1373
#                   Or  (FromPackage)
1374
#                       Our Package directory
1375
#                       Interface directory (BuildPkgArchives)
1376
#                       Packages (LinkPkgArchive)
407 dpurdie 1377
#                   Will scan 'parts' subdirs
1378
#
1379
# Inputs          : $from_package       - 0 - Local File
415 dpurdie 1380
#                   $file       - Basename for a 'realname'
407 dpurdie 1381
#                                 Do not provide 'lib' or '.so' or version info
1382
#                                 May contain embedded options
1383
#                                   --Dll - use Windows style versioned DLL
1384
#                                   --VersionDll - USe the versioned DLL
1385
#
1386
# Returns         : Path
1387
#
1388
sub ResolveLibFile
1389
{
1390
    my ($from_package, $file) = @_;
1391
    my $wildcard = ($file =~ /[*?]/);
1392
    my @options;
1393
    my $num_dll;
415 dpurdie 1394
    my @path;
407 dpurdie 1395
    #
1396
    #   Extract options from file
1397
    #
409 alewis 1398
    $num_dll = 0;
407 dpurdie 1399
    ($file, @options) = split ( ',', $file);
1400
    foreach ( @options )
1401
    {
1402
        if ( m/^--Dll/ ) {
1403
            $num_dll = 1;
1404
        } elsif ( m/^--VersionDll/ ) {
1405
            $num_dll = 2;
1406
        } else {
1407
            Error ("Unknown suboption to ResolveLibFile: $_" );
1408
        }
1409
    }
1410
 
1411
    #
415 dpurdie 1412
    #   Determine the paths to search
1413
    #
1414
    if ( $from_package )
1415
    {
1416
        unless ( @ResolveLibFileList )
1417
        {
1418
            push @ResolveLibFileList, $opt_pkgdir . '/lib';
1419
            foreach my $entry ( getPackageList() )
1420
            {
1421
                push @ResolveLibFileList, $entry->getLibDirs(3);
1422
            }
1423
        }
1424
        @path = @ResolveLibFileList;
1425
    }
1426
    else
1427
    {
1428
        @path = ($opt_libdir, $opt_locallibdir);
1429
    }
1430
 
1431
    #
407 dpurdie 1432
    #   Determine a full list of 'parts' to search
1433
    #   This is provided within the build information
1434
    #
1435
    my @parts = getPlatformParts ();
1436
    push @parts, '';
1437
 
1438
    my @done;
1439
    foreach my $root (  @path )
1440
    {
1441
        foreach my $type ( $opt_type, '' )
1442
        {
1443
            foreach my $subdir ( @parts )
1444
            {
1445
                my $sfile;
1446
                my $exact;
1447
                if ( $num_dll == 2 ) {
1448
                    $sfile = $file . $type . '.*.dll' ;
1449
                } elsif ( $num_dll == 1 ) {
1450
                    $sfile = $file . $type . '.dll' ;
1451
                    $exact = 1;
1452
                } else {
1453
                    $sfile = "lib" . $file . $type . '.so.*';
1454
                }
1455
 
1456
                $sfile = "$root/$subdir/$sfile";
1457
                $sfile =~ s~//~/~g;
1458
                Verbose2("LocateLibFile: $sfile");
1459
                if ( $exact )
1460
                {
415 dpurdie 1461
                    push @done, $sfile if ( -f $sfile || -l $sfile );
407 dpurdie 1462
                }
1463
                else
1464
                {
1465
                    push @done, glob ( $sfile );
1466
                }
1467
            }
1468
        }
1469
    }
1470
 
415 dpurdie 1471
    Error ("ResolveLibFile: File not found: $file", "Search Path:", @path)
407 dpurdie 1472
        unless ( @done );
1473
 
1474
    Warning ("ResolveLibFile: Multiple instances of file found. Only first is used", @done)
1475
        if ( $#done > 0 && ! $wildcard && !wantarray );
1476
 
1477
    return wantarray ? @done : $done[0];
1478
}
1479
 
1480
 
1481
#-------------------------------------------------------------------------------
1482
# Function        : AUTOLOAD
1483
#
1484
# Description     : Intercept bad user directives and issue a nice error message
1485
#                   This is a simple routine to report unknown user directives
1486
#                   It does not attempt to distinguish between user errors and
1487
#                   programming errors. It assumes that the program has been
1488
#                   tested. The function simply report filename and line number
1489
#                   of the bad directive.
1490
#
1491
# Inputs          : Original function arguments ( not used )
1492
#
1493
# Returns         : This function does not return
1494
#
1495
our $AUTOLOAD;
1496
sub AUTOLOAD
1497
{
1498
    my $fname = $AUTOLOAD;
1499
    $fname =~ s~^main::~~;
1500
    my ($package, $filename, $line) = caller;
1501
 
1502
    Error ("Directive not known or not allowed in this context: $fname",
1503
           "Directive: $fname( @_ );",
1504
           "File: $filename, Line: $line" );
1505
}
1506
 
1507
 
1508
1;
1509