1 #!perl

     2 # fshu.pm

     3 # 

     4 # Copyright (c) 2007 - 2010 Accenture. All rights reserved.

     5 # This component and the accompanying materials are made available

     6 # under the terms of the "Eclipse Public License v1.0"

     7 # which accompanies this distribution, and is available

     8 # at the URL "http://www.eclipse.org/legal/epl-v10.html".

     9 # 

    10 # Initial Contributors:

    11 # Accenture - Initial contribution

    12 #

    13 

    14 # Description:

    15 # fshu.pm - A collection of common utility sub-routines used by other fshell scripts.

    16 

    17 package fshu;

    18 use strict;

    19 use File::Path;

    20 use File::Copy;

    21 use File::Basename;

    22 

    23 #

    24 # Subs.

    25 #

    26 

    27 sub RelativePath {

    28   my $path = TidyPath(shift);

    29   my $relativeTo = TidyPath(shift);

    30   die "Error: \"$relativeTo\" is not absolute\n" unless ($relativeTo =~ /^([a-zA-Z]:)?\\/);

    31   $relativeTo =~ s/^([a-zA-Z]:)?\\//; # Remove drive letter and leading '\'.

    32   $path =~ s/^([a-zA-Z]:)?\\//; # Remove leading '\' and drive letter if present.

    33   foreach (split /\\/, $relativeTo) {

    34     $path = "..\\$path";

    35   }

    36   return $path;

    37 }

    38 

    39 sub AbsolutePath {

    40   my $path = TidyPath(shift);

    41   my $absoluteTo = TidyPath(shift);

    42 

    43   my @workingDir = ($path =~ /^\\/) ? () : split(/\\/, $absoluteTo);

    44   my @path = split(/\\/, $path);

    45 	

    46   foreach my $pathBit (@path) {

    47     next if ($pathBit eq '.');

    48     if ($pathBit eq '..') {

    49       pop @workingDir;

    50       next;

    51     }

    52     push @workingDir, $pathBit;

    53   }

    54 

    55   return join('\\', @workingDir);

    56 }

    57 

    58 sub TidyPath {

    59   my $path = shift;

    60   $path =~ s/\//\\/g;        # Change forward slashes to back slashes.

    61   $path =~ s/\\\.\\/\\/g;    # Change "\.\" into "\".

    62   $path =~ s/\\$//;          # Removing trailing slash.

    63 

    64   if ($path =~ /^\\\\/) {    # Test for UNC paths.

    65     $path =~ s/\\\\/\\/g;    # Change "\\" into "\".

    66     $path =~ s/^\\/\\\\/;    # Add back a "\\" at the start so that it remains a UNC path.

    67   }

    68   else {

    69     $path =~ s/\\\\/\\/g;    # Change "\\" into "\".

    70   }

    71 

    72   # Remove leading ".\" if doing so doesn't empty the string.

    73   $path =~ s/^\.\\(.+)/$1/;

    74 

    75   # Collapse ".."s in the middle of the path.

    76   my $foundFirstDirName = 0;

    77   my @path = split(/\\/, $path);

    78   my @collapsedPath;

    79   foreach my $pathBit (@path) {

    80     if (not $foundFirstDirName) {

    81       if ($pathBit ne '..') {

    82 	$foundFirstDirName = 1;

    83       }

    84       push (@collapsedPath, $pathBit);

    85     }

    86     else {

    87       if ($pathBit eq '..') {

    88 	pop (@collapsedPath);

    89       }

    90       else {

    91 	push (@collapsedPath, $pathBit);

    92       }

    93     }

    94   }

    95   $path = join('\\', @collapsedPath);

    96 

    97   return $path;

    98 }

    99 

   100 sub MakePath ($) {

   101   my $dir = shift;

   102   $dir =~ s/\//\\/g; # Convert all forward slashes to back slashes in path.

   103   unless (-e $dir) {

   104     if ($dir =~ /^\\\\/) {

   105       # This is a UNC path - make path manually because UNC isn't supported by mkpath.

   106       my $dirToMake = '';

   107       my @dirs = split /\\/, $dir;

   108       shift @dirs;  # Get rid of undefined dir.

   109       shift @dirs;  # Get rid of undefined dir.

   110       my $server = shift @dirs;

   111       my $share = shift @dirs;

   112       $dirToMake .= "\\\\$server\\$share";

   113       unless (-e $dirToMake) {

   114 	die "Network share \"$dirToMake\" does not exist\n";

   115       }

   116       foreach my $thisDir (@dirs) {

   117 	$dirToMake .=  "\\$thisDir";

   118 	unless (-e $dirToMake) {

   119 	  mkdir($dirToMake,0) or die "Couldn't make directory $dirToMake: $!\n";

   120 	}

   121       }

   122     }

   123     else {

   124       mkpath($dir) or die "Couldn't make path \"$dir\": $!\n";

   125     }

   126   }

   127 }

   128 

   129 sub CopyFile {

   130   my $from = TidyPath(shift);

   131   my $to = TidyPath(shift);

   132   my $verbose = shift;

   133 

   134   MakePath(dirname($to));

   135   print "Copying '$from' to '$to'...\n" if $verbose;

   136   copy ($from, $to) or die "Error: Couldn't copy '$from' to '$to' - $!\n";

   137 }

   138 

   139 sub Version {

   140   my $version = 'Unknown';

   141   my $kChangeHistoryFileName = "../../documentation/change_history.pod";

   142   open (HISTORY, $kChangeHistoryFileName) or die "Error: Couldn't open \"$kChangeHistoryFileName\" for reading: $!\n";

   143   while (my $line = <HISTORY>) {

   144     if ($line =~ /(Release \d+.*)/i) {

   145       $version = $1;

   146       last;

   147     }

   148   }

   149   close (HISTORY);

   150   return $version;

   151 }

   152 

   153 1;

   154 

   155 __END__

   156 

   157 =head1 NAME

   158 

   159 fshu.pm - A collection of common utility sub-routines used by other fshell scripts.

   160 

   161 =head1 COPYRIGHT

   162 

   163 Copyright (c) 2007-2010 Accenture. All rights reserved.

   164 

   165 =cut