ssphys/test/t/ssrep_1.t

   1 use Test::More 'no_plan';\r
   2 use strict;\r
   3 use File::Temp qw(tempdir);\r
   4 use VssCmd;\r
   5 use Vss2Svn::VSS;\r
   6 \r
   7 # XXX only runs on windows (ss.exe)\r
   8 \r
   9 # \r
  10 # XXX everything from here ...\r
  11 my $temp_dir = tempdir("tmpvssXXXXXX", CLEANUP => 0);\r
  12 $temp_dir = File::Spec->rel2abs($temp_dir);\r
  13 my $vss_log  = $temp_dir . "\\vsscmd.log";\r
  14 my $work_dir = $temp_dir . "\\vss_wc";\r
  15 my $vss_dir  = $temp_dir . "\\vss_repos";\r
  16 my $vss_proj = '$/';\r
  17 my $vss_user = "admin";\r
  18 mkdir $work_dir or die "error on 'mkdir $work_dir': $!";\r
  19 my $vss = VssCmd->new (vss_dir => $vss_dir, vss_user => $vss_user, vss_log => $vss_log);\r
  20 $vss->create();\r
  21 $vss->CurrentProject ($vss_proj);\r
  22 $vss->WorkFold ($work_dir);\r
  23 \r
  24 our ($TREE, $VSS);\r
  25 &Vss2Svn::VSS::Initialize;\r
  26 my $vss_args = {\r
  27 #                    interactive => 'Y',\r
  28 #                    timebias    => $gCfg{timebias},\r
  29                                         user            => $vss_user,\r
  30 #                                       passwd          => 'admin',\r
  31                                         executable      => "ssrep",\r
  32                                         silent      => 0,\r
  33                                         _debug      => 1,\r
  34                    };\r
  35 \r
  36 $VSS = Vss2Svn::VSS->new($vss_dir, $vss_proj, $vss_args);\r
  37 \r
  38 # XXX ... to here, could/should be wrapped up in some kinda library subroutine.\r
  39 # \r
  40 \r
  41 my $orig_cwd = Cwd->cwd();\r
  42 chdir $work_dir or die "chdir $work_dir: $!";\r
  43 # allow tempdir CLEANUP to work\r
  44 END { chdir $orig_cwd; }\r
  45 \r
  46 # END OF CUTANDPASTE...\r
  47 \r
  48 sub diff_items\r
  49 {\r
  50     my ($self, $curr_items, $prev_items) = @_;\r
  51     \r
  52     my @adds;\r
  53     my @dels;\r
  54     \r
  55     # what exists in CURR but not in PREV?  these were ADDED.\r
  56     \r
  57     foreach (keys %$curr_items)\r
  58     {\r
  59         push @adds, $curr_items->{$_} if not exists $prev_items->{$_};\r
  60     }\r
  61     \r
  62     # what exists in PREV but not in CURR?  these were DELETED.\r
  63     \r
  64     foreach (keys %$prev_items)\r
  65     {\r
  66         push @dels, $prev_items->{$_} if not exists $curr_items->{$_};\r
  67     }\r
  68     \r
  69     # return the adds and deletes.\r
  70     \r
  71     return (\@adds, \@dels);\r
  72 }\r
  73  \r
  74 sub checkListing\r
  75 {\r
  76     my ($self, $curr_items, $prev_items) = @_;\r
  77     \r
  78 print ("curr: $curr_items\n");\r
  79 print ("prev: $prev_items\n");\r
  80     my ($add_aref, $del_aref) = diff_items ($curr_items, $prev_items);\r
  81     \r
  82     my @adds = @$add_aref;\r
  83     my @dels = @$del_aref;\r
  84     \r
  85     # for ok, we want no euality of both lists (no addition, no deletion)\r
  86     ok (1) if $#dels == 0 and $#adds == 0;\r
  87     \r
  88     if ($#adds < 0) { fail ("failed, no added item."); }\r
  89     if ($#dels < 0) { fail ("failed, no deleted item."); }\r
  90     if ($#adds > 0) { fail ("failed, more than one added item."); }\r
  91     if ($#dels > 0) { fail ("failed, more than one deleted item."); }\r
  92     \r
  93     return undef;\r
  94 }  \r
  95 \r
  96 sub assert_project\r
  97 {\r
  98     my ($listing, $project) = @_;\r
  99     if ($listing->{$project} eq undef) {\r
 100         fail ("$project not found in listing");\r
 101     } elsif (ref ($listing->{$project}) ne 'HASH') {\r
 102         fail ("$project is not a project");\r
 103     }\r
 104 }\r
 105 \r
 106 sub assert_file\r
 107 {\r
 108     my ($listing, $file) = @_;\r
 109     if ($listing->{$file} eq undef) {\r
 110         fail ("$file not found in listing");\r
 111     } elsif ($listing->{$file} ne 1) {\r
 112         fail ("$file is not a file");\r
 113     }\r
 114 }\r
 115 \r
 116 my @sequence = ( ['add', 'test1'],\r
 117                  ['add', 'test2'],\r
 118                  ['create',  'project1'],\r
 119                  ['cp', 'project1'],\r
 120                  ['add',  'test1'],\r
 121                  ['add',  'test2'],\r
 122              );\r
 123 \r
 124 sub createFile \r
 125 {\r
 126     my ($filename) = @_;\r
 127     # create empty file\r
 128     open(FH,">$work_dir\\$filename") or die "error creating file '$filename'";\r
 129     close FH;\r
 130 }\r
 131 \r
 132 sub createProject \r
 133 {\r
 134     my ($filename) = @_;\r
 135     mkdir ("$work_dir\\$filename") or die "error creating directory '$filename'";\r
 136 }\r
 137 \r
 138 my $filename;\r
 139 \r
 140 $filename = 'test1';\r
 141 createFile ($filename);\r
 142 $vss->Add($filename);\r
 143 \r
 144 $filename = 'test2';\r
 145 createFile ($filename);\r
 146 $vss->Add($filename);\r
 147 \r
 148 $filename = 'project1';\r
 149 createProject ($filename);\r
 150 $vss->Create($filename);\r
 151 \r
 152 $filename = 'project1\\test3';\r
 153 createFile ($filename);\r
 154 $vss->Add($filename);\r
 155 \r
 156 $filename = 'project1\\test4';\r
 157 createFile ($filename);\r
 158 $vss->Add($filename);\r
 159 \r
 160 $filename = 'project2';\r
 161 createProject ($filename);\r
 162 $vss->Create($filename);\r
 163 \r
 164 $filename = 'project2\\test5';\r
 165 createFile ($filename);\r
 166 $vss->Add($filename);\r
 167 \r
 168 $filename = 'project2\\test6';\r
 169 createFile ($filename);\r
 170 $vss->Add($filename);\r
 171 \r
 172 \r
 173 \r
 174 my $listing;\r
 175 \r
 176 # directory list of tip revision\r
 177 $listing = $VSS->project_tree("",0)\r
 178  or fail ("dir \"\"");\r
 179 \r
 180 $listing = $VSS->project_tree("\$/",0)\r
 181   or fail ("dir \$/");\r
 182 \r
 183 $listing = $VSS->project_tree("\$/;4/project1",0)\r
 184   or fail ("dir \$/;4/project1");\r
 185 ok (1, "dir");\r
 186 \r
 187 \r
 188 sub dumpListing\r
 189 {\r
 190     my ($listing) = @_;\r
 191     foreach my $key (sort keys %$listing) {\r
 192         my $val = $listing->{$key};\r
 193             print ("$key => $val\n");\r
 194     }\r
 195 }\r
 196 \r
 197 # compare specific versions\r
 198 $listing = $VSS->project_tree("$/;1",0);\r
 199 #checkListing ($listing, ());\r
 200 $listing = $VSS->project_tree("$/;2",0);\r
 201 #checkListing ($listing, ("test1"));\r
 202 $listing = $VSS->project_tree("$/;3",0);\r
 203 #checkListing ($listing, ("test1", "test2"));\r
 204 $listing = $VSS->project_tree("$/;4",0);\r
 205 #checkListing ($listing, ("test1", "test2", "\$project1"));\r
 206 assert_file ($listing, "test1");\r
 207 assert_file ($listing, "test2");\r
 208 assert_project ($listing, "project1");\r
 209 \r
 210 \r
 211 \r
 212 \r
 213 # relative directory\r
 214 # VSS.pm can not handle relative directories\r
 215 #$TREE = $VSS->project_tree("\$",0)\r
 216 #$TREE = $VSS->project_tree(";1",0)\r
 217 #$TREE = $VSS->project_tree("\$;1/",0)\r
 218 #$TREE = $VSS->project_tree("\$;4/project1",0);\r
 219 \r
 220 # set cp to subdir\r
 221 $vss->CurrentProject ("\$/project1");\r
 222 #$TREE = $VSS->project_tree("",0)\r
 223 #$TREE = $VSS->project_tree(".",0)\r
 224 $TREE = $VSS->project_tree("\$/",0)\r
 225         or fail ("dir \$/");\r
 226 \r
 227 ok (1, "dir");\r