- Timestamp:
- 2013-07-03T21:37:18+12:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
other-projects/nightly-tasks/diffcol/trunk/diffcol/gdbdiff.pm
r27730 r27743 59 59 my $test_text = readin_gdb($test_cmd); 60 60 61 # my $savepath = &getcwd."/../"; # TASK_HOME env does not exist at this stage, but it's one level up from current directory61 # my $savepath = &getcwd."/../"; # TASK_HOME env var does not exist at this stage, but it's one level up from current directory 62 62 # print_string_to_file($test_text, $savepath.$dbname."_test.out"); 63 63 # print_string_to_file($model_text, $savepath.$dbname."_model.out"); … … 92 92 # Better regex is of the form /BEGIN((?:(?!BEGIN).)*)END/, see http://docstore.mik.ua/orelly/perl/cookbook/ch06_16.htm 93 93 94 $model_text =~ s@^([^\\//]*).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$3$5@mg; 95 $test_text =~ s@^([^\\//]*).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$3$5@mg; 94 $model_text =~ s@^([^\\/]*(//)*).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$4$6@mg; 95 $test_text =~ s@^([^\\/]*(//)*).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$4$6@mg; 96 #$model_text =~ s@^([^\\//]*).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$3$5@mg; 97 #$test_text =~ s@^([^\\//]*).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$3$5@mg; 96 98 } 97 99 … … 116 118 for my $line (split /^/, $$win_text) { # split the string into newlines 117 119 118 if($line =~ m@^<assoc-file>(.*)(\s+)@s) { 119 $line = $1; # may be a short file name 120 # assoc-file and meta-file contain filepaths, ensure these are long windows file paths now (will later convert to linux slashes) 121 if($line =~ m@^<(assoc-file|meta-file)>(.*)(\s+)@s) { 122 $line = $2; # may be a short file name 120 123 # perhaps test here if it is a shortfilename? should match /CAPS....~number(.ext)/ 121 124 122 $line = "< assoc-file>".&Win32::GetLongPathName($line)."$2"; # make it a long file name and prefix assoc-file to it again125 $line = "<$1>".&Win32::GetLongPathName($line)."$3"; # make it a long file name and prefix assoc-file/meta-file tagname to it again 123 126 } 124 127 $tmp .= $line; … … 127 130 } 128 131 129 # slashes in windows text need to be turned into linux style slashes 130 $$win_text =~ s@\\@/@g; 132 133 # index gdb file 134 if($dbname =~ m/$strColName/) { 135 my $tmp = ""; # rebuild windows file's set of lines after processing them one by one 136 for my $line (split /^/, $$win_text) { # split the string into newlines 137 138 if($line =~ m@^<ex.File.Directory>(.*)@s) { # word-pdf collection contains double windows backslashes 139 (my $escaped_path = $1) =~ s@\\\\@\\@g; 140 $line = "<ex.File.Directory>$escaped_path"; 141 } 142 elsif($line =~ m@^<Title>(.*)@s) { 143 # print STDERR "***** TITLE: |$1|\n"; 144 145 # word-pdf collection: Title of ps files contain new lines at end when 146 # GreenstoneXMLPlugin::xml_end_tag() writes the Title back out after utf8 decode 147 # if($metadata_name eq "Title") { $metadata_value =~ s/[\n\r]*$//; } 148 149 (my $title = $1) =~ s@(\r|\n|\\n)*$@@; # get rid of trailing newlines/carriage returns 150 $line = "<Title>$title\n"; # add single newline 151 } 152 $tmp .= $line; 153 } 154 $$win_text = $tmp; 155 } 156 157 158 # slashes in windows metadata text need to be turned into linux style slashes 159 $$win_text =~ s@\\@/@g; #$$win_text =~ s@\\([^n|r|\|"])@/$1@g; # filepath something\rtf remains something\rtf 131 160 132 161 # cut down absolute paths to files to just collect/colname/.../file, same as before 133 $$lin_text =~ s@^([^\\/ /]*).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$3$5@mg;134 $$win_text =~ s@^([^\\/ /]*).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$3$5@mg;162 $$lin_text =~ s@^([^\\/]*(//)*).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$4$6@mg; # $$lin_text =~ s@^([^\\\/]*(//)?).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$4$6@mg; 163 $$win_text =~ s@^([^\\/]*(//)*).*(\\|/)(collect(\\|/)$strColName)(.*)$@$1$4$6@mg; 135 164 136 165 # for the windows text, need to further get rid of the driveletter after [ or <meta> … … 166 195 my ($dbtailname, $db_contents) = @_; # db filename without suffix 167 196 168 if($dbtailname !~ m/archiveinf/) { # only archiveinf-doc and archive-inf source need special Windows processing, not col.gdb169 return 0;170 }197 #if($dbtailname !~ m/archiveinf/) { # only archiveinf-doc and archive-inf source need special Windows processing, not col.gdb 198 # return 0; 199 #} 171 200 return ($db_contents =~ m/\\/) ? 1 : 0; # windows slashes detected. Better test would be: [Something\something] OR <tag>something\something 172 201 # for doc.xml:
Note:
See TracChangeset
for help on using the changeset viewer.