Opening files specifying status and position - io

According to this source, I would interpret that specifying status="old" should append by default:
OLD, if the file is to be opened but not replaced
However, that is not what is happening in my codes. Here is an example:
program openstat_test
implicit none
integer :: mystat
mystat=0
print*,"Im trying to open a new file..."
open( unit=100, file="output.txt", status="new", iostat=mystat )
if ( mystat == 17 ) then
print*,"File already exists; overwriting!"
open( unit=100, file="output.txt", status="replace", iostat=mystat )
end if
if ( mystat /= 0 ) then
print*, "Error prevents test..."; stop
end if
write( unit=100, fmt=* ) "Line number 1"
close( unit=100)
print*,"Im trying to open an old file..."
open( unit=100, file="output.txt", status="old", iostat=mystat )
if ( mystat /= 0 ) then
print*, "Error prevents test..."; stop
end if
write( unit=100, fmt=* ) "Line number 2"
close( unit=100)
print*,"Im trying to open an old file AND FORCING APPEND..."
open( unit=100, file="output.txt", status="old", position="append", iostat=mystat )
if ( mystat /= 0 ) then
print*, "Error prevents test..."; stop
end if
write( unit=100, fmt=* ) "Line number 3"
close( unit=100)
end program openstat_test
("output.txt" only has "Line number 2" and "Line number 3"; the second open that uses status="old" is overwriting)
Am I'm missing something? Do you always need to specify position="append" even with status="old"? If so, why does the reference specify that "old" means opening but not replacing if the default writing command will overwrite the file?
Analogously, would it be safe to use position="append" without status (or with "unknown") to either create a new file or if the file exists append to it? I tried it and it works, but here says that the safe way to do it is case selecting without really explaining why or what could go wrong.

At a filesystem level there may well be differences between deleting a file then creating one with the same name and overwriting the contents of a file. This could relate to attributes or permissions and so on.
status='old' means that the named file exists at the time of connection. status='replace' for a file which exists first deletes the file and then creates a new one with the same name.
As you can see, then, it is reasonable for status='old' to lead to overwriting. The reference you quote doesn't say exactly what the Fortran standard says.
Without giving position=... the default is 'asis'. In the case where a file isn't currently connected the file position is left unspecified. If you wish to append you should explicitly give position='append'.
With status='unknown' (the default) the status is processor dependent. It isn't possible to definitively say what that means.

Related

Add eight thousand line in one commit [closed]

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 4 years ago.
Improve this question
I have a log file, perl script who took the log file and transcript the log file, i want to send this all line (eight thousand line) in one commit
my script:
# Connect to the database.
my $dbh = DBI->connect(
"DBI:mysql:database=DB;host=>IP",
"hostname", 'password',
{'RaiseError' => 1,'AutoCommit'=> 0}
);
open (FILE, 'file.log');
while (<FILE>) {
($word1, $word2, $word3, $word4, $word5, $word6, $word7, $word8, $word9, $word10, $word11, $word12, $word13, $word14) = split(" ");
$word13 =~ s/[^\d.]//g;
if ($word2 eq "Feb") {
$word2 = "02"
}
print "'$word5-$word2-$word3 $word4', $word11, $word13 \n";
eval {
#on peut utiliser insert mais il y aura des doublons et ici on est dans une table unique
my $sth = $dbh->prepare("INSERT INTO `test_query` (time, cstep, time_in_seconde) VALUES('$word5-$word2-$word3 $word4', $word11, $word13);");
#print $sth->rows . " rows found.\n";
#$sth->finish;
# do inserts, updates, deletes, queries here
#$sth->execute() or die "execution failed: $dbh->errstr()";
$sth->execute() or die "execution failed: $dbh->errstr()";
$dbh->commit();
};
### If something went wrong...
}
}
$dbh->disconnect();
thanks
For better performance, you want to simplify your code and move as many code as possible out of the loop :
prepare the statement out of the loop, using bind parameters : the statement is always the same, only bind parameters get to change
commit out of the loop : this will increase performance and also has the advantage of making your process atomic. As all changes occur within the same database transaction, either all lines will be processed (and commited), or, if a failure occurs on any line, no line at all will be commited. While implementing this optimization you need to watch for resource usage on your database (this will typically require more space in the UNDO tablespace) ; if resources are not enough, either increase them or commit every Nth record (with N being as high as possible)
avoid printing inside the loop unless your really need it (I commented that line)
you are building a connection with RaiseError attribute enabled, but then you ignore errors that can occur at execute. If this is really what you want, then just disable the RaiseError attribute on the statement handler, and remove the eval around execute
Other considerations in terms of coding practices :
always use strict and use warnings
use an array to store parsed data instead of a list of scalars : could make your code faster and will make it more readable
Code :
use strict;
use warnings;
# Connect to the database.
my $dbh = DBI->connect(
"DBI:mysql:database=DB;host=>IP",
"hostname", 'password',
{'RaiseError' => 1,'AutoCommit'=> 0}
);
# prepare the insert statement
my $sth = $dbh->prepare("INSERT INTO `test_query` (time, cstep, time_in_seconde) VALUES(?, ?, ?)");
$sth->{RaiseError} = 0;
open (my $file, 'file.log') or die "could not open : $!";
while (<$file>) {
my #words = split / /;
$words[12] =~ s/[^\d.]//g;
if ($words[1] eq "Feb") {
$words[1] = "02" ;
}
# print "'$words[4]-$words[1]-$words[2] $words[3]', $words[10], $words[12] \n";
$sth->execute( "$words[4]-$words[1]-$words[2] $words[3]", $words[10], $words[12] );
}
$dbh->commit;
$dbh->disconnect;
The last solution, that would probably perform even faster than this one, is to use DBI method execute_array to perform bulk database inserts. Attribute ArrayTupleFetch can be used to provide a code reference that DBI will invoke everytime it is ready to perform the next INSERT : this code reference should read the next file line and provide an array reference of values suitable for INSERT. When the file is exhausted, the sub should return undef, which will indicate DBI that the bulk process is completed.
Code :
#!/usr/local/bin/perl
use strict;
use warnings;
use DBI;
# open the file
open (my $file, 'log.file') or die "could not open : $!";
# connect the database
my $dbh = DBI->connect("DBI:mysql:database=DB;host=ip", "hostname", 'password', {'RaiseError' => 1,'AutoCommit'=> 0});
# prepare the INSERT statement
my $sth = $dbh->prepare("INSERT INTO `test_query` (time, cstep, time_in_seconde) VALUES(?, ?, ?)");
# run bulk INSERTS
my $tuples = $sth->execute_array({
ArrayTupleStatus => \my #tuple_status,
ArrayTupleFetch => sub {
my $line = <$file>;
return unless $line;
my #words = split / /;
# ... do anything you like with the array, then ...
return [ "$words[4]-$words[1]-$words[2] $words[3]", $words[10], $words[12] ];
}
});
if ($tuples) {
print "Successfully inserted $tuples records\n";
} else {
# do something usefull with #tuple_status, that contains the detailed results
}
$dbh->commit;
$dbh->disconnect;

Perl multithreading - thread doesn't start

I need some help, I can't figure out why my thread doesn't want to start. I don't have experience with perl, and was asked to make a script that will process a file row by row. Depending on the row, the process should execute other functions (not in snippet), call the same function on a new file or call the same function on a new file in parallel (thread).
Below, I pasted a snippet of the actual code (removed the non-relevant code).
I'm testing the multithreading part on a function called "test" which should print "ok".
The process executes correctly, "start" is printed, but then it gets stuck and after a brief delay, the process stops executing completely.
A thousand thanks to whoever may help me!
use strict;
use warnings;
use IO::Prompter;
use Getopt::Long;
use Log::Message::Simple;
use File::Basename;
use File::Spec;
use IO::Socket::INET;
use UUID::Tiny ':std';
use threads;
use threads::shared;
# *bunch of code deleted*
process_file( $cmdline{csvfile}, 1 );
sub test {
print "ok\n";
}
sub process_file {
# get parameters
my ( $input_file, $flowid ) = #_;
# init variables
# open input file
open( my $fh, '<:encoding(UTF-8)', $input_folder . $input_file )
or die "Could not open file '$input_file' $!";
# process file
while ( my $row = <$fh> ) {
chomp $row;
#request = split ";", $row;
$flow_type = $request[0];
$flow = $request[1];
# *bunch of code deleted*
$filename = "$flow.csv";
$keep_flowid = $request[2]; # keep flowid?
$tmp_flowid = $keep_flowid ? $flowid : undef; # set flowid
$thread = $request[3];
if ( $thread == 1 ) {
### Create new thread
print "start\n";
my $process_thread = threads->create("test");
$process_thread->join();
}
elsif ( $thread == 0 ) {
# wait on process to complete
process_file( $filename, $tmp_flowid );
}
# *bunch of code deleted*
}
# close file
close $fh or die "Couldn't close inputfile: $input_file";
}
It's hard to say exactly why you're having this problem - the major possiblity seems to be:
$thread = $request[3];
if ($thread == 1){
This is input from your filehandle, so a real possiblity is that "$request[3]" isn't actually 1.
I am a bit suspicious though - your code as use strict; use warnings at the top, but you're not declaring e.g. $thread, $flow etc. with my. That either means you're not using strict, or you're reusing variables - which is a good way to end up with annoying glitches (like this one).
But as it stands - we can't tell you for sure, because we cannot reproduce the problem to test it. In order to do this, we would need some sample input and a MCVE
To expand on the point about threads made in the comments - you may see warnings that they are "Discouraged". The major reason for this, is because perl threads are not like threads in other languages. They aren't lightweight, where in other languages they are. They're perfectly viable solutions to particular classes of problems - specifically, the ones where you need parallelism with more IPC than a fork based concurrency model would give you.
I suspect you are experiencing this bug, fixed in Perl 5.24.
If so, you could work around it by performing your own decoding rather than using an encoding layer.

How to save a table to a file from Lua

I'm having trouble printing a table to a file with lua (and I'm new to lua).
Here's some code I found here to print the table;
function print_r ( t )
local print_r_cache={}
local function sub_print_r(t,indent)
if (print_r_cache[tostring(t)]) then
print(indent.."*"..tostring(t))
else
print_r_cache[tostring(t)]=true
if (type(t)=="table") then
for pos,val in pairs(t) do
if (type(val)=="table") then
print(indent.."["..pos.."] => "..tostring(t).." {")
sub_print_r(val,indent..string.rep(" ",string.len(pos)+8))
print(indent..string.rep(" ",string.len(pos)+6).."}")
elseif (type(val)=="string") then
print(indent.."["..pos..'] => "'..val..'"')
else
print(indent.."["..pos.."] => "..tostring(val))
end
end
else
print(indent..tostring(t))
end
end
end
if (type(t)=="table") then
print(tostring(t).." {")
sub_print_r(t," ")
print("}")
else
sub_print_r(t," ")
end
print()
end
I have no idea where the 'print' command goes to, I'm running this lua code from within another program. What I would like to do is save the table to a .txt file. Here's what I've tried;
function savetxt ( t )
local file = assert(io.open("C:\temp\test.txt", "w"))
file:write(t)
file:close()
end
Then in the print-r function I've changed everywhere it says 'print' to 'savetxt'. This doesn't work. It doesn't seem to access the text file in any way. Can anyone suggest an alternative method?
I have a suspicion that this line is the problem;
local file = assert(io.open("C:\temp\test.txt", "w"))
Update;
I have tried the edit suggested by Diego Pino but still no success. I run this lua script from another program (for which I don't have the source), so I'm not sure where the default directory of the output file might be (is there a method to get this programatically?). Is is possible that since this is called from another program there's something blocking the output?
Update #2;
It seems like the problem is with this line:
local file = assert(io.open("C:\test\test2.txt", "w"))
I've tried changing it "C:\temp\test2.text", but that didn't work. I'm pretty confident it's an error at this point. If I comment out any line after this (but leave this line in) then it still fails, if I comment out this line (and any following 'file' lines) then the code runs. What could be causing this error?
I have no idea where the 'print' command goes to,
print() output goes to default output file, you can change that with io.output([file]), see Lua manuals for details on querying and changing default output.
where do files get created if I don't specify the directory
Typically it will land in current working directory.
Your print_r function prints out a table to stdout. What you want is to print out the output of print_r to a file. Change the print_r function so instead of printing to stdout, it prints out to a file descriptor. Perhaps the easiest way to do that is to pass a file descriptor to print_r and overwrite the print function:
function print_r (t, fd)
fd = fd or io.stdout
local function print(str)
str = str or ""
fd:write(str.."\n")
end
...
end
The rest of the print_r doesn't need any change.
Later in savetxt call print_r to print the table to a file.
function savetxt (t)
local file = assert(io.open("C:\temp\test.txt", "w"))
print_r(t, file)
file:close()
end
require("json")
result = {
["ip"]="192.168.0.177",
["date"]="2018-1-21",
}
local test = assert(io.open("/tmp/abc.txt", "w"))
result = json.encode(result)
test:write(result)
test:close()
local test = io.open("/tmp/abc.txt", "r")
local readjson= test:read("*a")
local table =json.decode(readjson)
test:close()
print("ip: " .. table["ip"])
2.Another way:
http://lua-users.org/wiki/SaveTableToFile
Save Table to File
function table.save( tbl,filename )
Load Table from File
function table.load( sfile )

perl untar single file

So running into an issue with my code here not sure what exactly i'm doing wrong i pass it the two arguments it searches for the file but its always going to does not exist.
i pass this to the file
perl restore.cgi users_old_52715.tar.gz Ace_Walker
its not finding the file it exist i assure you.
#!/usr/bin/perl
use Archive::Tar;
my $tarPath = $ARGV[0];
my $playerfile = $ARGV[1].".ini";
my $tar = Archive::Tar->new($tarPath);
if ($tar->contains_file($playerfile)) {
$tar->read($tarPath);
$tar->extract_file($playerfile, './' );
print "Successfully restored $playerfile to production enviroment\n";
exit 0;
}else{
print $playefile." does not exist in this archive!\n";
exit 0;
}
Just writing Scott Hunter's comment as an answer:
Try using an absolute path instead of a relative one.
if( $tar->extract_file($playerfile, './'.$playerfile )){
print "Successfully restored $playerfile to production enviroment\n";
}
exit 0;
man Archive::Tar :
$tar->extract_file( $file, [$extract_path] )
Write an entry, whose name is equivalent to the file name provided to disk. Optionally takes a second parameter, which is the full native path (including filename) the entry will be written to.

Compare many text files that contain duplicate "stubs" from the previous and next file and remove duplicate text automatically

I have a large number of text files (1000+) each containing an article from an academic journal. Unfortunately each article's file also contains a "stub" from the end of the previous article (at the beginning) and from the beginning of the next article (at the end).
I need to remove these stubs in preparation for running a frequency analysis on the articles because the stubs constitute duplicate data.
There is no simple field that marks the beginning and end of each article in all cases. However, the duplicate text does seem to formatted the same and on the same line in both cases.
A script that compared each file to the next file and then removed 1 copy of the duplicate text would be perfect. This seems like it would be a pretty common issue when programming so I am surprised that I haven't been able to find anything that does this.
The file names sort in order, so a script that compares each file to the next sequentially should work. E.G.
bul_9_5_181.txt
bul_9_5_186.txt
are two articles, one starting on page 181 and the other on page 186. Both of these articles are included bellow.
There is two volumes of test data located at [http://drop.io/fdsayre][1]
Note: I am an academic doing content analysis of old journal articles for a project in the history of psychology. I am no programmer, but I do have 10+ years experience with linux and can usually figure things out as I go.
Thanks for your help
FILENAME: bul_9_5_181.txt
SYN&STHESIA
ISI
the majority of Portugese words signifying black objects or ideas relating to black. This association is, admittedly, no true synsesthesia, but the author believes that it is only a matter of degree between these logical and spontaneous associations and genuine cases of colored audition.
REFERENCES
DOWNEY, JUNE E. A Case of Colored Gustation. Amer. J. of Psycho!., 1911, 22, S28-539MEDEIROS-E-ALBUQUERQUE. Sur un phenomene de synopsie presente par des millions de sujets. / . de psychol. norm, et path., 1911, 8, 147-151. MYERS, C. S. A Case of Synassthesia. Brit. J. of Psychol., 1911, 4, 228-238.
AFFECTIVE PHENOMENA — EXPERIMENTAL
BY PROFESSOR JOHN F. .SHEPARD
University of Michigan
Three articles have appeared from the Leipzig laboratory during the year. Drozynski (2) objects to the use of gustatory and olfactory stimuli in the study of organic reactions with feelings, because of the disturbance of breathing that may be involved. He uses rhythmical auditory stimuli, and finds that when given at different rates and in various groupings, they are accompanied by characteristic feelings in each subject. He records the chest breathing, and curves from a sphygmograph and a water plethysmograph. Each experiment began with a normal record, then the stimulus was given, and this was followed by a contrast stimulus; lastly, another normal was taken. The length and depth of breathing were measured (no time line was recorded), and the relation of length of inspiration to length of expiration was determined. The length and height of the pulsebeats were also measured. Tabular summaries are given of the number of times the author finds each quantity to have been increased or decreased during a reaction period with each type of feeling. The feeling state accompanying a given rhythm is always complex, but the result is referred to that dimension which seemed to be dominant. Only a few disconnected extracts from normal and reaction periods are reproduced from the records. The author states that excitement gives increase in the rate and depth of breathing, in the inspiration-expiration ratio, and in the rate and size of pulse. There are undulations in the arm volume. In so far as the effect is quieting, it causes decrease in rate and depth of
182
JOHN F. SHEPARD
breathing, in the inspiration-expiration ratio, and in the pulse rate and size. The arm volume shows a tendency to rise with respiratory waves. Agreeableness shows
It looks like a much simpler solution would actually work.
No one seems to be using the information provided by the filenames. If you do make use of this information, you may not have to do any comparisons between files to identify the area of overlap. Whoever wrote the OCR probably put some thought into this problem.
The last number in the file name tells you what the starting page number for that file is. This page number appears on a line by itself in the file as well. It also looks like this line is preceded and followed by blank lines. Therefore for a given file you should be able to look at the name of the next file in the sequence and determine the page number at which you should start removing text. Since this page number appears in your file just look for a line that contains only this number (preceded and followed by blank lines) and delete that line and everything after. The last file in the sequence can be left alone.
Here's an outline for an algorithm
choose a file; call it: file1
look at the filename of the next file; call it: file2
extract the page number from the filename of file2; call it: pageNumber
scan the contents of file1 until you find a line that contains only pageNumber
make sure this line is preceded and followed by a blank line.
remove this line and everything after
move on to the next file in the sequence
You should probably try something like this (I've now tested it on the sample data you provided):
#!/usr/bin/ruby
class A_splitter
Title = /^[A-Z]+[^a-z]*$/
Byline = /^BY /
Number = /^\d*$/
Blank_line = /^ *$/
attr_accessor :recent_lines,:in_references,:source_glob,:destination_path,:seen_in_last_file
def initialize(src_glob,dst_path=nil)
#recent_lines = []
#seen_in_last_file = {}
#in_references = false
#source_glob = src_glob
#destination_path = dst_path
#destination = STDOUT
#buffer = []
split_em
end
def split_here
if destination_path
#destination.close if #destination
#destination = nil
else
print "------------SPLIT HERE------------\n"
end
print recent_lines.shift
#in_references = false
end
def at_page_break
((recent_lines[0] =~ Title and recent_lines[1] =~ Blank_line and recent_lines[2] =~ Number) or
(recent_lines[0] =~ Number and recent_lines[1] =~ Blank_line and recent_lines[2] =~ Title))
end
def print(*args)
(#destination || #buffer) << args
end
def split_em
Dir.glob(source_glob).sort.each { |filename|
if destination_path
#destination.close if #destination
#destination = File.open(File.join(#destination_path,filename),'w')
print #buffer
#buffer.clear
end
in_header = true
File.foreach(filename) { |line|
line.gsub!(/\f/,'')
if in_header and seen_in_last_file[line]
#skip it
else
seen_in_last_file.clear if in_header
in_header = false
recent_lines << line
seen_in_last_file[line] = true
end
3.times {recent_lines.shift} if at_page_break
if recent_lines[0] =~ Title and recent_lines[1] =~ Byline
split_here
elsif in_references and recent_lines[0] =~ Title and recent_lines[0] !~ /\d/
split_here
elsif recent_lines.length > 4
#in_references ||= recent_lines[0] =~ /^REFERENCES *$/
print recent_lines.shift
end
}
}
print recent_lines
#destination.close if #destination
end
end
A_splitter.new('bul_*_*_*.txt','test_dir')
Basically, run through the files in order, and within each file run through the lines in order, omitting from each file the lines that were present in the preceding file and printing the rest to STDOUT (from which it can be piped) unless a destination director is specified (called 'test_dir' in the example see the last line) in which case files are created in the specified directory with the same name as the file which contained the bulk of their contents.
It also removes the page-break sections (journal title, author, and page number).
It does two split tests:
a test on the title/byline pair
a test on the first title-line after a reference section
(it should be obvious how to add tests for additional split-points).
Retained for posterity:
If you don't specify a destination directory it simply puts a split-here line in the output stream at the split point. This should make it easier for testing (you can just less the output) and when you want them in individual files just pipe it to csplit (e.g. with
csplit -f abstracts - '---SPLIT HERE---' '{*}'
or something) to cut it up.
Here's is the beginning of another possible solution in Perl (It works as is but could probably be made more sophisticated if needed). It sounds as if all you are concerned about is removing duplicates across the corpus and don't really care if the last part of one article is in the file for the next one as long as it isn't duplicated anywhere. If so, this solution will strip out the duplicate lines leaving only one copy of any given line in the set of files as a whole.
You can either just run the file in the directory containing the text files with no argument or alternately specify a file name containing the list of files you want to process in the order you want them processed. I recommend the latter as your file names (at least in the sample files you provided) do not naturally list out in order when using simple commands like ls on the command line or glob in the Perl script. Thus it won't necessarily compare the correct files to one another as it just runs down the list (entered or generated by the glob command). If you specify the list, you can guarantee that they will be processed in the correct order and it doesn't take that long to set it up properly.
The script simply opens two files and makes note of the first three lines of the second file. It then opens a new output file (original file name + '.new') for the first file and writes out all the lines from the first file into the new output file until it finds the first three lines of the second file. There is an off chance that there are not three lines from the second file in the last one but in all the files I spot checked that seemed to be the case because of the journal name header and page numbers. One line definitely wasn't enough as the journal title was often the first line and that would cut things off early.
I should also note that the last file in your list of files entered will not be processed (i.e. have a new file created based off of it) as it will not be changed by this process.
Here's the script:
#!/usr/bin/perl
use strict;
my #files;
my $count = #ARGV;
if ($count>0){
open (IN, "$ARGV[0]");
#files = <IN>;
close (IN);
} else {
#files = glob "bul_*.txt";
}
$count = #files;
print "Processing $count files.\n";
my $lastFile="";
foreach(#files){
if ($lastFile ne ""){
print "Processing $_\n";
open (FILEB,"$_");
my #fileBLines = <FILEB>;
close (FILEB);
my $line0 = $fileBLines[0];
if ($line0 =~ /\(/ || $line0 =~ /\)/){
$line0 =~ s/\(/\\\(/;
$line0 =~ s/\)/\\\)/;
}
my $line1 = $fileBLines[1];
my $line2 = $fileBLines[2];
open (FILEA,"$lastFile");
my #fileALines = <FILEA>;
close (FILEA);
my $newName = "$lastFile.new";
open (OUT, ">$newName");
my $i=0;
my $done = 0;
while ($done != 1 and $i < #fileALines){
if ($fileALines[$i] =~ /$line0/
&& $fileALines[$i+1] == $line1
&& $fileALines[$i+2] == $line2) {
$done=1;
} else {
print OUT $fileALines[$i];
$i++;
}
}
close (OUT);
}
$lastFile = $_;
}
EDIT: Added a check for parenthesis in the first line that goes into the regex check for duplicity later on and if found escapes them so that they don't mess up the duplicity check.
You have a nontrivial problem. It is easy to write code to find the duplicate text at the end of file 1 and the beginning of file 2. But you don't want to delete the duplicate text---you want to split it where the second article begins. Getting the split right might be tricky---one marker is the all caps, another is the BY at the start of the next line.
It would have helped to have examples from consecutive files, but the script below works on one test case. Before trying this code, back up all your files. The code overwrites existing files.
The implementation is in Lua.
The algorithm is roughly:
Ignore blank lines at the end of file 1 and the start of file 2.
Find a long sequence of lines common to end of file 1 and start of file 2.
This works by trying a sequence of 40 lines, then 39, and so on
Remove sequence from both files and call it overlap.
Split overlap at title
Append first part of overlap to file1; prepend second part to file2.
Overwrite contents of files with lists of lines.
Here's the code:
#!/usr/bin/env lua
local ext = arg[1] == '-xxx' and '.xxx' or ''
if #ext > 0 then table.remove(arg, 1) end
local function lines(filename)
local l = { }
for line in io.lines(filename) do table.insert(l, (line:gsub('', ''))) end
assert(#l > 0, "No lines in file " .. filename)
return l
end
local function write_lines(filename, lines)
local f = assert(io.open(filename .. ext, 'w'))
for i = 1, #lines do
f:write(lines[i], '\n')
end
f:close()
end
local function lines_match(line1, line2)
io.stderr:write(string.format("%q ==? %q\n", line1, line2))
return line1 == line2 -- could do an approximate match here
end
local function lines_overlap(l1, l2, k)
if k > #l2 or k > #l1 then return false end
io.stderr:write('*** k = ', k, '\n')
for i = 1, k do
if not lines_match(l2[i], l1[#l1 - k + i]) then
if i > 1 then
io.stderr:write('After ', i-1, ' matches: FAILED <====\n')
end
return false
end
end
return true
end
function find_overlaps(fname1, fname2)
local l1, l2 = lines(fname1), lines(fname2)
-- strip trailing and leading blank lines
while l1[#l1]:find '^[%s]*$' do table.remove(l1) end
while l2[1] :find '^[%s]*$' do table.remove(l2, 1) end
local matchsize -- # of lines at end of file 1 that are equal to the same
-- # at the start of file 2
for k = math.min(40, #l1, #l2), 1, -1 do
if lines_overlap(l1, l2, k) then
matchsize = k
io.stderr:write('Found match of ', k, ' lines\n')
break
end
end
if matchsize == nil then
return false -- failed to find an overlap
else
local overlap = { }
for j = 1, matchsize do
table.remove(l1) -- remove line from first set
table.insert(overlap, table.remove(l2, 1))
end
return l1, overlap, l2
end
end
local function split_overlap(l)
for i = 1, #l-1 do
if l[i]:match '%u' and not l[i]:match '%l' then -- has caps but no lowers
-- io.stderr:write('Looking for byline following ', l[i], '\n')
if l[i+1]:match '^%s*BY%s' then
local first = {}
for j = 1, i-1 do
table.insert(first, table.remove(l, 1))
end
-- io.stderr:write('Split with first line at ', l[1], '\n')
return first, l
end
end
end
end
local function strip_overlaps(filename1, filename2)
local l1, overlap, l2 = find_overlaps(filename1, filename2)
if not l1 then
io.stderr:write('No overlap in ', filename1, ' an
Are the stubs identical to the end of the previous file? Or different line endings/OCR mistakes?
Is there a way to discern an article's beginning? Maybe an indented abstract? Then you could go through each file and discard everything before the first and after (including) the second title.
Are the titles & author always on a single line? And does that line always contain the word "BY" in uppercase? If so, you can probably do a fair job withn awk, using those criteria as the begin/end marker.
Edit: I really don't think that using diff is going to work as it is a tool for comparing broadly similar files. Your files are (from diff's point of view) actually completely different - I think it will get out of sync immediately. But then, I'm not a diff guru :-)
A quick stab at it, assuming that the stub is strictly identical in both files:
#!/usr/bin/perl
use strict;
use List::MoreUtils qw/ indexes all pairwise /;
my #files = #ARGV;
my #previous_text;
for my $filename ( #files ) {
open my $in_fh, '<', $filename or die;
open my $out_fh, '>', $filename.'.clean' or die;
my #lines = <$in_fh>;
print $out_fh destub( \#previous_text, #lines );
#previous_text = #lines;
}
sub destub {
my #previous = #{ shift() };
my #lines = #_;
my #potential_stubs = indexes { $_ eq $lines[0] } #previous;
for my $i ( #potential_stubs ) {
# check if the two documents overlap for that index
my #p = #previous[ $i.. $#previous ];
my #l = #lines[ 0..$#previous-$i ];
return #lines[ $#previous-$i + 1 .. $#lines ]
if all { $_ } pairwise { $a eq $b } #p, #l;
}
# no stub detected
return #lines;
}

Resources