Generated: Mon Aug 16 14:14:40 2010 from test-file-spec.pl 2010/01/16 2.4 KB.
#!/perl -w # NAME: test-file-spec.pl # AIM: Some simple tests of File::Spec use strict; use warnings; use File::Basename; use Cwd; use File::Spec; unshift(@INC, 'C:\GTools\perl'); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $perl_dir = 'C:\GTools\perl'; my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $load_log = 0; ### program variables my @warnings = (); my $cwd = cwd(); sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg) } close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ); } } sub test_dir_rel_2_abs($) { my ($p) = @_; my $abs_path = File::Spec->rel2abs($p); # NOTE my $abs_path = rel2abs($p); FAILS my ($nm,$dir) = fileparse($abs_path); my $msg = 'ok'; if (! -d $abs_path) { $msg = "NO SUCH DIRECTORY" } prt("Converted path [$p], to absolute [$abs_path], file [$nm], path [$dir]\n"); } sub test_rel_abs($$) { my ($in,$rel) = @_; my $cd = cwd(); my ($nm,$dir) = fileparse($in); if ( chdir($dir) ) { my $ap = File::Spec->rel2abs($rel); #my $ap = rel2abs($rel); prt("From [$in], in [$dir], changed\n [$rel], to\n [$ap]\n"); chdir($cd); } else { prt("ERROR: No change to [$dir]!\n"); } } ######################################### ### MAIN ### prt( "$pgmname: in [$cwd]: Hello, World...\n" ); my $in_file = 'C:\FG\32\fgfs\fgfs.sln'; my $rel_proj = '..\alut\admin\VisualStudioDotNET\alut\alut.vcproj'; my $proj_file = 'alut\admin\VisualStudioDotNET\alut\alut.vcproj'; my $rel_src = '..\..\..\src\alutBufferData.c'; my $path = 'temp1'; test_dir_rel_2_abs($path); test_dir_rel_2_abs('temp2'); test_rel_abs($in_file,$rel_proj); pgm_exit(0,"Normal exit(0) in ".cwd()); ######################################## # eof - template.pl