fgsln2dsw02.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:36 2010 from fgsln2dsw02.pl 2008/10/31 14.7 KB.

#!/perl -w
# NAME: fgsln2dsw02.pl
# AIM: Read solution file (SLN), and extract projects,
# write appropriate DSP file, and finally write DSW file.
# 30/10/2008 geoff mclane - http://geoffair.net/fg
use strict;
use warnings;
use File::Basename;
use Cwd;
require 'fgutils.pl' or die "Unable to load fgutils.pl ...\n";
require 'fgdsphdrs.pl' or die "Unable to load fgdsphdrs.pl ...\n";
require 'fgscanvc.pl' or die "Unable to load fgscanvc.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
    my @tmpsp = split(/\\/,$pgmname);
    $pgmname = $tmpsp[-1];
}
my $outfile = "temp.$pgmname.txt";
open_log($outfile);
my $write_temp_only = 0;    # Off to WRITE actual DSW/DSP file - any previous are backed up ...
my $in_file = 'fgfs\fgfs.sln';
# $hash{'PROJECTS'} = { %sln_projects }; # PROJECTS = [ ul = PLIB\src\util\ul.vcproj ]
# $hash{'PROJPATH'} = { %sln_projpath }; # PROJPATH = [ ul = ..\PLIB\src\util\ ]
# $hash{'DEPENDS'} = { %sln_depends  };  # DEPENDS = [ SimGear = zlib|puAux|libpng|ssg... ]
# $hash{'PROJIDS'} = { %sln_projids };   # PROJIDS = [ ul = {A4CD75C6-3F7E-4497-8503-F9CEE50F7F41} ]
my @hash_keys = qw( SOLUTION PROJECTS PROJPATH DEPENDS PROJIDS );
# DEBUG
my $dbg_sl01 = 0;   # show prt( "Got PROJECT name=$projname, file=$projff, rel=[$relpath].
my $dbg_sl02 = 0;   # show prt( "Proj $projname, dependant on $arr[0] ...
my $dbg_sl03 = 0;   # show prt( "proj $projname, depends on $nmdeps ...
my $dbg_sl04 = 0;   # show show_solution( \%solution ) ...
my @warnings = ();
my %solution = process_SLN_file($in_file);
#show_solution_simple(\%solution) if ($dbg_sl04);
show_solution(\%solution) if ($dbg_sl04);
set_dbg_props() if ($write_temp_only);    # Off to WRITE actual DSW/DSP file - any previous are backed up ...
process_solution_hash(0,\%solution);
show_warnings();
close_log($outfile,1);
exit(0);
###############################################################################
### SUBS ONLY
sub fg_add_proj_begin {
   my ($fh, $prj, $fil) = @_;
   print $fh <<EOF;
###############################################################################
Project: "$prj"=".\\$fil" - Package Owner=<4>
Package=<5>
{{{
}}}
Package=<4>
{{{
EOF
}
sub fg_add_proj_depends {
   my ($fh, $prj, $rd) = @_;
   my ($pdeps, @arr, $dpn);
   if (defined $$rd{$prj}) {
      $pdeps = $$rd{$prj};
      if (length($pdeps)) {
         @arr = split( /\|/, $pdeps );
         foreach $dpn (@arr) {
            print $fh "    Begin Project Dependency\n";
            print $fh "    Project_Dep_Name $dpn\n";
            print $fh "    End Project Dependency\n";
         }
      }
   } else {
      prtw( "WARNING: Project $prj NOT defined in sln_depends!!!\n" );
   }
}
sub fg_add_proj_end {
   my ($fh) = shift;
   print $fh <<EOF;
}}}
EOF
}
sub process_solution_hash { # (\%solution);
    my ($dbg_bits, $sr) = @_;
    my ($key, $val, $k2);
    my ($proj, $file, $rpath, $id, $sln_file);
    my ($ref_proj, $ref_path, $ref_deps, $ref_ids);
    my ($out_file);
    my ($nam,$dir,$ext);
    my ($msg);
    my %dsw_projects = ();  # output DSP file, by PROJECT key
    my %dsw_projpath = ();  # blank - not used
    my @written = ();
    # 1. Extract the HASH REFERENCES of each key
    foreach $key (@hash_keys) {
        $val = $$sr{$key};
        if ($key eq 'PROJECTS') {
            $ref_proj = $val;
        } elsif ($key eq 'PROJPATH') {
            $ref_path = $val;
        } elsif ($key eq 'DEPENDS') {
            $ref_deps = $val;
        } elsif ($key eq 'PROJIDS') {
            $ref_ids = $val;
        } elsif ($key eq 'SOLUTION') {
            $sln_file = $val;
        } else {
            prtw("WARNING: case for key [$key] NOT YET DONE!\n");
        }
    }
    # 2. Process each PROJECT, extracting VCPROJ file, process it, and write DSP file
    foreach $k2 (keys %{$ref_proj}) {
        $proj  = $k2;
        $file  = $$ref_proj{$k2};
        $rpath = $$ref_path{$k2};
        $id    = $$ref_ids{$k2};
        my %h = process_VCPROJ( $file );
        show_hash_results($dbg_bits,\%h) if ($dbg_bits);
        ($nam, $dir, $ext) = fileparse($file, qr/\.[^.]*/ );
        $out_file = $rpath.$nam.'.dsp';
        $dsw_projects{$proj} = $out_file;
        $dsw_projpath{$proj} = '';
        $out_file = $dir.$nam.'.dsp'; # out to SAME directory/name, with DSP extension
        # but if $write_temp_only OUTPUT ONLY A TEMP file
        $out_file = 'temp.'.$proj.'.dsp' if ($write_temp_only);
        write_hash_to_DSP($out_file, \%h, $dbg_bits);
        # more for a DEBUG view
        $msg = $proj.'|'.$rpath.$nam.'.dsp';
        $out_file = $dir.$nam.'.dsp';
        $msg .= "|$out_file";
        push(@written, $msg);
    }
    # 3. Output a DSW file
    ($nam, $dir, $ext) = fileparse($sln_file, qr/\.[^.]*/ );
    $out_file = $dir.$nam.'.dsw';   # same directory, name, but with DSW extension
    prt( "\nFrom $sln_file to $out_file ...\n" );
    # but if $write_temp_only OUTPUT ONLY A TEMP file
    $out_file = 'temp.'.$nam.'.dsw' if ($write_temp_only);
    my ($DSW, $i, $prj, $fil, $rfile, $rp);
   my @prjlist = sort keys(%{$ref_proj});
   my $prjcnt = scalar @prjlist;
   my @donelist = ();
    if ($prjcnt == 0) {
        prtw( "WARNING: NO PROJECTS IN \%dsw_projects!!!\n".
            "SO NO DSW FILE CREATED! Why is hash (ref) blank???\n" );
        return;
    }
    rename_2_old_bak($out_file);
   if (open $DSW, ">$out_file") {
        # WRITE DSW FILE
      $msg = get_dsw_head();
      print $DSW $msg;
      for ($i = 0; $i < $prjcnt; $i++) {
         $prj = $prjlist[$i];
         if ( !is_in_array($prj, @donelist) ) {
            $fil = $dsw_projects{$prj};
            $rp  = $dsw_projpath{$prj};
            $fil = $rp."\\".$fil if (length($rp));
            fg_add_proj_begin( $DSW, $prj, $fil );
            # add any DEPENDENCIES NOW
            fg_add_proj_depends( $DSW, $prj, $ref_deps );
            fg_add_proj_end( $DSW );
         }
      }
      $msg = get_dsw_tail();
      print $DSW $msg;
      close $DSW;
      # diagnostic OUTPUT
        foreach $file (@written) {
            prt( "$file\n" );
        }
      prt( "Written [$out_file] file ... with $prjcnt projects ...\n" );
   } else {
      prtw("ERROR: Unable to WRITE $out_file ...\n" );
   }   
}
sub show_solution {
    my ($sr) = shift;
    my ($key, $val, $k2);
    my ($proj, $file, $rpath, $id);
    my ($ref_proj, $ref_path, $ref_deps, $ref_ids,$sln_file);
    my ($msg, $part);
    my $mxplen = 0;
    my $mxfile = 0;
    my $mxrpath = 0;
    foreach $key (@hash_keys) {
        $val = $$sr{$key};
        if ($key eq 'PROJECTS') {
            $ref_proj = $val;
        } elsif ($key eq 'PROJPATH') {
            $ref_path = $val;
        } elsif ($key eq 'DEPENDS') {
            $ref_deps = $val;
        } elsif ($key eq 'PROJIDS') {
            $ref_ids = $val;
        } elsif ($key eq 'SOLUTION') {
            $sln_file = $val;
            prt("\nShow for solution file $sln_file ...\n");
        } else {
            prtw("WARNING: case for key [$key] NOT YET DONE!\n");
        }
    }
    foreach $k2 (keys %{$ref_proj}) {
        $proj = $k2;
        $mxplen = length($proj) if (length($proj) > $mxplen);
        $file = $$ref_proj{$k2};
        $mxfile = length($file) if (length($file) > $mxfile);
        $rpath = $$ref_path{$k2};
        $mxrpath = length($rpath) if (length($rpath) > $mxrpath);
        $id = $$ref_ids{$k2};
    }
    prt( "From processing $sln_file, got -\n" );
    foreach $k2 (keys %{$ref_proj}) {
        $proj = $k2;
        $file = $$ref_proj{$k2};
        $rpath = $$ref_path{$k2};
        $id = $$ref_ids{$k2};
        $part = (( -f $file ) ? "ok" : "NO");
        while(length($proj) < $mxplen) {$proj .= ' ';}
        while(length($file) < $mxfile) {$file .= ' ';}
        $file .= " $part";
        while(length($rpath) < $mxrpath) {$rpath .= ' ';}
        prt( "PROJECT $proj, file=[$file], rel=[$rpath]\n" ); #, id=[$id]\n" );
    }
}
sub show_solution_simple {
    my ($sr) = shift;
    my ($key, $val, $k2, $v2);
    foreach $key (keys %{$sr}) {
        $val = $$sr{$key};
        if ($key eq 'SOLUTION') {
            prt("Solution file = [$val]\n" );
        } else {
            foreach $k2 (keys %{$val}) {
                $v2 = $$val{$k2};
                prt( "$key = [ $k2 = $v2 ]\n" );
            }
        }
    }
}
sub is_vcproj {
   my $fil = shift;
   if ($fil =~ /\.vcproj$/i) {
      return 1;
   }
   return 0;
}
# Read and store contents of SOLUTION (.sln) file
# 22/04/2008 - Extract DEPENDENCIES from solution file, and add to DSW output
sub process_SLN_file {
   my ($fil) = shift;
   my ($cnt, $line, $vers, @arr, $mver, $par, $ff, $itmnum);
   my ($projname, $projfile, $projff, $gotproj, $relpath);
   my ($tnm,$tpth);
   my ($inproj, $tline, $projid, $inpdeps, $projdeps);
    my ($nmdeps, $depid, $pn);
    my ($msg);
   open IF, "<$fil" or mydie( "ERROR: Unable to open $fil ... $! ...\n" );
   my @lines = <IF>;
   close IF;
   $cnt = scalar @lines;
   my ($name,$sln_path) = fileparse($fil);
    my %hash = ();
    my %sln_projects = ();
    my %sln_projpath = ();
    my %sln_depends = ();
    my %sln_projids = ();
   prt( "\nProcessing $cnt lines ... n=[$name] p=[$sln_path] ...\n" );
   $projname = '';
   $projfile = '';
   $projff = '';
   $gotproj = 0;
   $inproj = 0;
   $inpdeps = 0;
   foreach $line (@lines) {
      $tline = trim_all($line);
      if ($line =~ /.+Format\s+Version\s+(\d+\.\d+)$/i) {
         $vers = $1;   # get n.nn version
         @arr = split(/\./,$vers);
         $mver = $arr[0];
         prt( "Is MSVC Version $mver ...\n" );
      } elsif ($line =~ /^Project\s*\(/) {
         # seek like 
         #Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "abyss", "abyss.vcproj", "{8B384B8A-2B72-4DC4-8DF1-E3EF32F18850}"
         ###prt( "Got project [$line] ...\n" );
         $inproj = 1;
         @arr = split( '=', $line );
         $cnt = scalar @arr;
         if ($cnt == 2) {
            $par = $arr[1];
            @arr = split(',', $par);
            $cnt = scalar @arr;
            if ($cnt == 3) {
               $projname = strip_quotes(trim_all($arr[0]));
               $projfile = strip_quotes(trim_all($arr[1]));
               $projid   = strip_quotes(trim_all($arr[2]));
               $projff = fix_rel_path($sln_path.$projfile);
               if ((length($projname)) && (is_vcproj($projfile)) && (-f $projff)) {
                  $gotproj = 1;
                  ($tnm,$tpth) = fileparse($projff);
                  $relpath = get_rel_dos_path($tpth, $sln_path);
                  prt( "Got PROJECT name=$projname, file=$projff, rel=[$relpath].\n" ) if ($dbg_sl01);
                  if (defined $sln_projects{$projname}) {
                     mydie( "A PROBLEM: Already GOT this project name $projname!!!\n" );
                  } else {
                     $sln_projects{$projname} = $projff;
                     $sln_projpath{$projname} = $relpath; # can be BLANK, or say 'BvMath/'
                     $sln_projids{$projname}  = $projid;
                     $sln_depends{$projname}  = '';   # start dependencies, if any
                  }
               } else {
                  $msg = "WARNING: ";
                  if (!length($projname)) {
                     $msg .= "Failed to get a project name! ";
                  } elsif ( !is_vcproj($projfile) ) {
                     $msg .= "Name [$projfile] NOT a VCPROJ name! ";
                  } else {
                     $msg .= "Unable to locate file [$projff]! ";
                  }
                  $msg .= " Line is (trimmed)\n$tline";
                        prtw("$msg\n");
               }
            } else {
               prtw( "Warning: Part 2 of Project line did NOT split into 3 on comma!???\n" );
            }
         } else {
            prtw( "Warning: Project line did NOT split in 2 on equal sign!???\n" );
         }
         # to switch on $tryharder requires additional work on parsing this line
         # =====================================================================
         if (!$gotproj) {
                prtw("WARNING: line [$line] ...\n");
         }
         # =====================================================================
      } elsif ($inproj) {
         # in the Project section - look for END of section, and DEPENDENCIES
         # ProjectSection(ProjectDependencies)
         if ($tline eq 'EndProject') {
         ###if ($line =~ /^EndProject\s*/)
            $inproj = 0;
         } else {
            if ($inpdeps) {
               if ($tline eq 'EndProjectSection' ) {
                  $inpdeps = 0;
               } else {
                  # collect dependencies
                  @arr = split( '=', $line );
                  $cnt = scalar @arr;
                  if ($cnt == 2) {
                     $arr[0] = trim_all($arr[0]);
                     $arr[1] = trim_all($arr[1]);
                     if ($arr[0] eq $arr[1]) {
                        $projdeps = $sln_depends{$projname};   # extract dependencies, if any
                        $projdeps .= '|' if (length($projdeps));
                        $projdeps .= $arr[0];
                        prt( "Proj $projname, dependant on $arr[0] ...\n" ) if ($dbg_sl02);
                        ##prt( "Proj $projname, dependant on $projdeps ...\n" );
                        $sln_depends{$projname} = $projdeps;
                     } else {
                        prtw( "Warning: Found different IDS '$arr[0]' NE '$arr[1]'!!! \n" );
                     }
                  } else {
                     prtw( "Warning: Project DEPENDENCY line did NOT split in 2 on equal sign!???\n" );
                     prtw( "line=$line" );
                  }
               }
            } elsif ($line =~ /ProjectSection\s*\(\s*ProjectDependencies\s*\)/) {
               $inpdeps = 1;
            }
         }
      }
   }
   ###prt( "Done $fil ... got ".scalar @proj_files." project files ...\n" );
   prt( "Done $fil ... got ".scalar keys(%sln_projects)." project files ...\n" );
   # resolve dependencies, if possible - warn if NOT ...
   #resolve_depends();
   foreach $projname (keys %sln_projects) {
      $projdeps = $sln_depends{$projname};
      if (length($projdeps)) {
         # there is LENGTH, convert giant CID to simple project names
         @arr = split( /\|/, $projdeps );   # split em up
         $cnt = scalar @arr;   # get count of split
         #prt( "Proj $projname, depends on $cnt = $projdeps ...\n" );
         $nmdeps = '';   # build simple NAME set
         foreach $depid (@arr) {
            foreach $pn (keys %sln_projids) {
               if ($pn ne $projname) {
                  $projid = $sln_projids{$pn};
                  if ($depid eq $projid) {
                     $nmdeps .= '|' if (length($nmdeps));
                     $nmdeps .= $pn;
                     last;
                  }
               }
            }
         }
         @arr = split( /\|/, $nmdeps );
         prt( "proj $projname, depends on $nmdeps ...\n" ) if ($dbg_sl03);
         if ($cnt != scalar @arr) {   # YEEK - Does NOT match - OH WELL
            prtw( "WARNING: Failed to get SAME count $cnt - got ".scalar @arr."!\n" );
         }
         $sln_depends{$projname} = $nmdeps;
      }
   }
    $hash{'SOLUTION'} = $fil;   # keep the SOLUTION files also
    $hash{'PROJECTS'} = { %sln_projects };
    $hash{'PROJPATH'} = { %sln_projpath };
    $hash{'DEPENDS'} = { %sln_depends  };
    $hash{'PROJIDS'} = { %sln_projids };
    return %hash;
}
sub prtw {
    my ($tx) = shift;
    if ($tx =~ /\n$/) {
        prt($tx);
        $tx =~ s/\n$//;
    } else {
        prt("$tx\n");
    }
    push(@warnings,$tx);
}
sub show_warnings {
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS ...\n" );
        foreach my $line (@warnings) {
            prt("$line\n" );
        }
        prt("\n");
    } else {
        prt("\nNo warnings issued.\n\n");
    }
}
# eof - fgsln2dsw02.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional