Subversion Repositories DevTools

Rev

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

Rev 6177 Rev 6276
Line 31... Line 31...
31 
#                    FileCreate                 - Create a simple text file
 31 
#                    FileCreate                 - Create a simple text file
32 
#                    FileAppend                 - Append to a simple text file
 32 
#                    FileAppend                 - Append to a simple text file
33 
#                    TagFileMatch               - Simple (oneline) file content matcher
 33 
#                    TagFileMatch               - Simple (oneline) file content matcher
34 
#                    TagFileRead                - Return the contents of the tagfile
 34 
#                    TagFileRead                - Return the contents of the tagfile
35 
#                    RmDirTree                  - Remove a directory tree
 35 
#                    RmDirTree                  - Remove a directory tree
- 
 
 36 
#                    CatPaths                   - Concatenate Paths
36 
#           ReExported
 37 
#           ReExported
37 
#                    catdir                     - Concatenate path elements
 38 
#                    catdir                     - Concatenate path elements
38 
#                    catfile                    - Concatenate path elements and a file
 39 
#                    catfile                    - Concatenate path elements and a file
39 
#
 40 
#
40 
#......................................................................#
 41 
#......................................................................#
Line 81... Line 82...
81 
                FileCreate
 82 
                FileCreate
82 
                FileAppend
 83 
                FileAppend
83 
                TagFileMatch
 84 
                TagFileMatch
84 
                TagFileRead
 85 
                TagFileRead
85 
                RmDirTree
 86 
                RmDirTree
- 
 
 87 
                CatPaths
86 
                catfile
 88 
                catfile
87 
                catdir
 89 
                catdir
88 
 
 90 
 
89 
                $ScmPathSep
 91 
                $ScmPathSep
90 
                $ScmDirSep
 92 
                $ScmDirSep
91 
                $Cwd
 93 
                $Cwd
- 
 
 94 
                $CwdFull
92 
                $CwdDrive
 95 
                $CwdDrive
93 
                $ScmHost
 96 
                $ScmHost
94 
            );
 97 
            );
95 
#
 98 
#
96 
# exported package globals go here
 99 
# exported package globals go here
Line 274... Line 277...
274 
    my $mode = shift @_;
 277 
    my $mode = shift @_;
275 
    my $name = shift @_;
 278 
    my $name = shift @_;
276 
    my $fh;
 279 
    my $fh;
277 
 
 280 
 
278 
    Error ("FileCreate: No file specified") unless ( $name );
 281 
    Error ("FileCreate: No file specified") unless ( $name );
279 
    Error ("FileCreate: Path is directory") if ( -d $name );
 282 
    Error ("FileCreate: Path is directory", 'Path :' . $name) if ( -d $name );
280 
 
 283 
 
281 
    open  ($fh, $mode, $name ) || Error( "Cannot create file: $name", "Reason: $!" );
 284 
    open  ($fh, $mode, $name ) || Error( "Cannot create file: $name", "Reason: $!" );
282 
 
 285 
 
283 
    foreach my $entry ( @_ ) {
 286 
    foreach my $entry ( @_ ) {
284 
        if ( ref ($entry ) eq 'ARRAY'  ) {
 287 
        if ( ref ($entry ) eq 'ARRAY'  ) {
Line 435... Line 438...
435 
# Returns         : Relative path from the current directory to the base directory
 438 
# Returns         : Relative path from the current directory to the base directory
436 
#
 439 
#
437 
sub RelPath
 440 
sub RelPath
438 
{
 441 
{
439 
    my ($base, $here) = @_;
 442 
    my ($base, $here) = @_;
- 
 
 443 
    unless (defined $base)
- 
 
 444 
    {
- 
 
 445 
        DebugTraceBack ('RelPath');
- 
 
 446 
        Error ("Internal: 'RelPath(). base not defined'");
- 
 
 447 
    }
440 
 
 448 
 
441 
    $here = $Cwd unless ( defined $here );
 449 
    $here = $Cwd unless ( defined $here );
- 
 
 450 
    $here = $CwdDrive . $here if ( $base =~ m~^\w+:/~ && $here !~ m~^\w+:/~);
442 
    my @base = split ('/', $base );
 451 
    my @base = split ('/', $base );
443 
    my @here = split ('/', $here );
 452 
    my @here = split ('/', $here );
444 
    my $result;
 453 
    my $result;
445 
 
 454 
 
446 
    Debug("RelPath: Here  : $here");
 455 
    Debug("RelPath: Here  : $here");
Line 492... Line 501...
492 
#
 501 
#
493 
sub AbsPath
 502 
sub AbsPath
494 
{
 503 
{
495 
    my ($dpath, $here, $mode) = @_;
 504 
    my ($dpath, $here, $mode) = @_;
496 
    my @result;
 505 
    my @result;
- 
 
 506 
    unless (defined $dpath)
- 
 
 507 
    {
- 
 
 508 
        DebugTraceBack ();
- 
 
 509 
        Error ("Internal: 'AbsPath(). dpath not defined'");
- 
 
 510 
    }
497 
 
 511 
 
498 
    #
 512 
    #
499 
    #   If we have a relative path then prepend the current directory
 513 
    #   If we have a relative path then prepend the current directory
500 
    #   An absolute path is:
 514 
    #   An absolute path is:
501 
    #           /aaa/aa/aa
 515 
    #           /aaa/aa/aa
Line 579... Line 593...
579 
my %TruePathCache;
 593 
my %TruePathCache;
580 
my %DirRead;
 594 
my %DirRead;
581 
sub TruePath
 595 
sub TruePath
582 
{
 596 
{
583 
    my ($path) = @_;
 597 
    my ($path) = @_;
- 
 
 598 
    Debug("TruePath: $path");
584 
    $path =~ tr~\\/~/~s;
 599 
    $path =~ tr~\\/~/~s;
585 
 
 600 
 
586 
    #
 601 
    #
587 
    #   On Unix systems the path is case sensitive to start with
 602 
    #   On Unix systems the path is case sensitive to start with
588 
    #   Can't get it wrong - can't do anything.
 603 
    #   Can't get it wrong - can't do anything.
Line 699... Line 714...
699 
    my @result;
 714 
    my @result;
700 
    Debug("CleanPath: Source: $dpath");
 715 
    Debug("CleanPath: Source: $dpath");
701 
 
 716 
 
702 
    #
 717 
    #
703 
    #   Cleanup the the user input. Remove double delimiters and ensure there
 718 
    #   Cleanup the the user input. Remove double delimiters and ensure there
704 
    #   is no trailing delemiter
 719 
    #   is no trailing delimiter
705 
    #
 720 
    #
- 
 
 721 
    $dpath =~ s~\\~/~g;
- 
 
 722 
    $dpath =~ s~^\./~~g;
- 
 
 723 
    $dpath =~ s~/\./~/~g;
706 
    $dpath =~ s~/+~/~g;
 724 
    $dpath =~ s~/+~/~g;
707 
    $dpath =~ s~/$~~g;
 725 
    $dpath =~ s~/$~~g;
708 
    $dpath =~ s~/\./~/~g;
 - 
 
709 
 
 726 
 
710 
    #
 727 
    #
711 
    #   Walk the bits and remove "xxx/.." directories
 728 
    #   Walk the bits and remove "xxx/.." directories
712 
    #
 729 
    #
713 
    foreach ( split ( '/', $dpath ) )
 730 
    foreach ( split ( '/', $dpath ) )
Line 726... Line 743...
726 
            }
 743 
            }
727 
        }
 744 
        }
728 
    }
 745 
    }
729 
 
 746 
 
730 
    my $result = join ( '/', @result );
 747 
    my $result = join ( '/', @result );
- 
 
 748 
    $result = '.' unless $result;
731 
    Debug("CleanPath: Result: $result");
 749 
    Debug("CleanPath: Result: $result");
732 
    return $result;
 750 
    return $result;
733 
}
 751 
}
734 
 
 752 
 
735 
#-------------------------------------------------------------------------------
 753 
#-------------------------------------------------------------------------------
- 
 
 754 
# Function        : CatPaths
- 
 
 755 
#
- 
 
 756 
# Description     : Join path elemanets together with a '/'
- 
 
 757 
#                   Clean up the result
- 
 
 758 
#
- 
 
 759 
# Inputs          : Patth elemenst to join
- 
 
 760 
#
- 
 
 761 
# Returns         : Cleaned up path elements
- 
 
 762 
#
- 
 
 763 
sub CatPaths
- 
 
 764 
{
- 
 
 765 
    Debug("CatPaths: @_ ");
- 
 
 766 
    return CleanPath join ('/', @_);
- 
 
 767 
}
- 
 
 768 
 
- 
 
 769 
#-------------------------------------------------------------------------------
736 
# Function        : StripDrive
 770 
# Function        : StripDrive
737 
#
 771 
#
738 
# Description     : Strip any leading drive speification
 772 
# Description     : Strip any leading drive speification
739 
#
 773 
#
740 
# Inputs          : $fname          - Path to process
 774 
# Inputs          : $fname          - Path to process