DBD::CSV: How can I generate different behavior with the two f_ext-options ".csv" and ".csv/r"? - perl

This is from the DBD::File-documentation:
f_ext
This attribute is used for setting the file extension where (CSV) files are opened. There are several possibilities.
DBI:CSV:f_dir=data;f_ext=.csv
In this case, DBD::File will open only table.csv if both table.csv and table exist in the datadir. The table will still be named table. If your datadir has files with extensions, and you do not pass this attribute, your table is named table.csv, which is probably not what you wanted. The extension is always case-insensitive. The table names are not.
DBI:CSV:f_dir=data;f_ext=.csv/r
In this case the extension is required, and all filenames that do not match are ignored.
It was not possible for me to generate different behavior with the two options ".csv/r" and ".csv". Could someone show me an example, where I can see the difference between ".csv/r" and ".csv"?

I can't seem to get it to do anything different either. The relevant section of code is
sub file2table
{
my ($data, $dir, $file, $file_is_tab, $quoted) = #_;
$file eq "." || $file eq ".." and return;
my ($ext, $req) = ("", 0);
if ($data->{f_ext}) {
($ext, my $opt) = split m/\//, $data->{f_ext};
if ($ext && $opt) {
$opt =~ m/r/i and $req = 1;
}
}
(my $tbl = $file) =~ s/$ext$//i;
$file_is_tab and $file = "$tbl$ext";
# Fully Qualified File Name
my $fqfn;
unless ($quoted) { # table names are case insensitive in SQL
opendir my $dh, $dir or croak "Can't open '$dir': $!";
my #f = grep { lc $_ eq lc $file } readdir $dh;
#f == 1 and $file = $f[0];
closedir $dh or croak "Can't close '$dir': $!";
}
$fqfn = File::Spec->catfile ($dir, $file);
$file = $fqfn;
if ($ext) {
if ($req) {
# File extension required
$file =~ s/$ext$//i or return;
}
else {
# File extension optional, skip if file with extension exists
grep m/$ext$/i, glob "$fqfn.*" and return;
$file =~ s/$ext$//i;
}
}
$data->{f_map}{$tbl} = $fqfn;
return $tbl;
} # file2table

Does this demonstrate the difference?:
sandbox % echo "a,b,c" > foo
sandbox % echo "a,b,c" > foo.csv
sandbox % echo "a,b,c" > bar
sandbox % echo "a,b,c" > baz.csv
sandbox % perl -MDBI -wle'print for DBI->connect("dbi:CSV:f_ext=.csv")->tables'
"merijn".baz
"merijn".bar
"merijn".foo
sandbox % perl -MDBI -wle'print for DBI->connect("dbi:CSV:f_ext=.csv/r")->tables'
"merijn".baz
"merijn".foo
sandbox %
f_ext=.csv only makes the .csv a preference, but nor a requirement: in the first case, the file "bar" with no .csv extension is still used, but "foo.csv" is chosen over "foo". With f_ext=.csv/r", "bar" is ignored, as it has no ".csv" extension.

Now in version 0.39 of DBD::File this part looks like this:
sub file2table
{
my ($self, $meta, $file, $file_is_table, $respect_case) = #_;
$file eq "." || $file eq ".." and return; # XXX would break a possible DBD::Dir
my ($ext, $req) = ("", 0);
if ($meta->{f_ext}) {
($ext, my $opt) = split m/\//, $meta->{f_ext};
if ($ext && $opt) {
$opt =~ m/r/i and $req = 1;
}
}
# (my $tbl = $file) =~ s/$ext$//i;
my ($tbl, $dir, $user_spec_file);
if ($file_is_table and defined $meta->{f_file}) {
$tbl = $file;
($file, $dir, undef) = File::Basename::fileparse ($meta->{f_file});
$user_spec_file = 1;
}
else {
($tbl, $dir, undef) = File::Basename::fileparse ($file, $ext);
$user_spec_file = 0;
}
-d File::Spec->catdir ($meta->{f_dir}, $dir) or
croak (File::Spec->catdir ($meta->{f_dir}, $dir) . ": $!");
!$respect_case and $meta->{sql_identifier_case} == 1 and # XXX SQL_IC_UPPER
$tbl = uc $tbl;
!$respect_case and $meta->{sql_identifier_case} == 2 and # XXX SQL_IC_LOWER
$tbl = lc $tbl;
my $searchdir = File::Spec->file_name_is_absolute ($dir)
? $dir
: Cwd::abs_path (File::Spec->catdir ($meta->{f_dir}, $dir));
$searchdir eq $meta->{f_dir} and
$dir = "";
unless ($user_spec_file) {
$file_is_table and $file = "$tbl$ext";
# Fully Qualified File Name
my $cmpsub;
if ($respect_case) {
$cmpsub = sub {
my ($fn, undef, $sfx) = File::Basename::fileparse ($_, qr/\.[^.]*/);
$fn eq $tbl and
return (lc $sfx eq lc $ext or !$req && !$sfx);
return 0;
}
}
else {
$cmpsub = sub {
my ($fn, undef, $sfx) = File::Basename::fileparse ($_, qr/\.[^.]*/);
lc $fn eq lc $tbl and
return (lc $sfx eq lc $ext or !$req && !$sfx);
return 0;
}
}
opendir my $dh, $searchdir or croak "Can't open '$searchdir': $!";
my #f = sort { length $b <=> length $a } grep { &$cmpsub ($_) } readdir $dh;
#f > 0 && #f <= 2 and $file = $f[0];
!$respect_case && $meta->{sql_identifier_case} == 4 and # XXX SQL_IC_MIXED
($tbl = $file) =~ s/$ext$//i;
closedir $dh or croak "Can't close '$searchdir': $!";
#(my $tdir = $dir) =~ s{^\./}{}; # XXX We do not want all tables to start with ./
#$tdir and $tbl = File::Spec->catfile ($tdir, $tbl);
$dir and $tbl = File::Spec->catfile ($dir, $tbl);
my $tmpfn = $file;
if ($ext) {
if ($req) {
# File extension required
$tmpfn =~ s/$ext$//i or return;
}
# else {
# # File extension optional, skip if file with extension exists
# grep m/$ext$/i, glob "$fqfn.*" and return;
# $tmpfn =~ s/$ext$//i;
# }
}
}
my $fqfn = File::Spec->catfile ($searchdir, $file);
my $fqbn = File::Spec->catfile ($searchdir, $tbl);
$meta->{f_fqfn} = $fqfn;
$meta->{f_fqbn} = $fqbn;
!defined $meta->{f_lockfile} && $meta->{f_lockfile} and
$meta->{f_fqln} = $meta->{f_fqbn} . $meta->{f_lockfile};
$meta->{table_name} = $tbl;
return $tbl;
} # file2table
As far as I can see, the two f_ext-options are working as expected.

Related

how to replace specific line by write appending to file

i have two files . one is user's input file and another file is original config file. After comparing two files , do add/delete functions in my original config file.
user's input file: (showing line by line)
add:L28A:Z:W #add--> DID ID --> Bin ID
del:L28C:B:Q:X:
rpl:L38A:B:M:D:
original input file
L28A:B:Q:M:X:
L28C:B:Q:M:X:
L38A:B:Q:M:X:
based on user's input file , first is doing add function second is delete function and third is replace function.
so output for original input txt file should show:
L28A:B:Q:M:X:Z:W
L28C:M:
L38A:B:M:D:
but my code is showing :
L28A:B:Q:M:X:
L28C:B:Q:M:X:
L38A:B:Q:M:X:
L28A:B:Q:M:X:Z:W
L28C:M:
L38A:B:M:D:
how can i replace above three lines with new modify lines?
use strict;
use warnings;
use File::Copy;
use vars qw($requestfile $requestcnt $configfile $config2cnt $my3file $myfile3cnt $new_file $new_filecnt #output);
my $requestfile = "DID1.txt"; #user's input file
my $configfile = "DID.txt"; #original config file
my $new_file = "newDID.txt";
readFileinString($requestfile, \$requestcnt);
readFileinString($configfile, \$config2cnt);
copy($configfile, $new_file) or die "The copy operation failed: $!";
while ($requestcnt =~ m/^((\w){3})\:([^\n]+)$/mig) #Each line from user request
{
my $action = $1;
my $requestFullLine = $3;
while ($requestFullLine =~ m/^((\w){4})\:([^\n]+)$/mig) #Each line from user request
{
my $DID = $1; #DID
my $requestBinList = $3; #Bin List in user request
#my #First_values = split /\:/, $requestBinList;
if ($config2cnt =~ m/^$DID\:([^\n]+)$/m) #configfile
{
my $ConfigFullLine = $1; #Bin list in config
my $testfile = $1;
my #First_values = split /\:/, $ConfigFullLine;
my #second_values = split /\:/, $requestBinList;
foreach my $sngletter(#second_values) # Each line from user request
{
if( grep {$_ eq "$sngletter"} #First_values)
{
print " $DID - $sngletter - Existing bin..\n\n";
}
else
{
print "$DID - $sngletter - Not existing bin..\n\n";
}
}
print "Choose option 1.Yes 2.No\n";
my $option = <STDIN>;
if ($option == 1) {
open(DES,'>>',$configfile) or die $!;
if($action eq 'add')
{
$ConfigFullLine =~ s/$/$requestBinList/g;
my $add = "$DID:$ConfigFullLine";
print DES "$add\n" ;
print"New Added Bin Valu $add\n\n";
}
if ( $action eq 'del')
{
foreach my $sngletter(#second_values){
$ConfigFullLine =~ s/$sngletter://g;
}
print DES "$DID:$ConfigFullLine\n";
print "New Deleted Bin Value $DID:$ConfigFullLine\n\n";
}
if ( $action eq 'rpl')
{
my $ConfigFullLine = $requestBinList;
my $replace = "$DID:$ConfigFullLine";
print DES "$replace\n";
print"Replace Bin Value $replace\n\n";
}
}
elsif ($option == 2)
{
print"Start from begining\n";
}
else
{
print "user chose invalid process or input is wrong\n";
}
}
else
{
print "New DID $DID detected\n";}
}
}
sub readFileinString
{
my $File = shift;
my $string = shift;
use File::Basename;
my $filenames = basename($File);
open(FILE1, "<$File") or die "\nFailed Reading File: [$File]\n\tReason: $!";
read(FILE1, $$string, -s $File, 0);
close(FILE1);
}
The problem is here:
open(DES,'>>',$configfile) or die $!;
You open your file for appending. So you get the original data, followed by your edited data.
Update: It appears that you have a working solution now, but I thought it might be interesting to show you how I would write this.
This program is a Unix filter. That is, it reads from STDIN and writes to STDOUT. I find that far more flexible than hard-coded filenames. You also don't have to explicitly open files - which saves time :-)
It also takes a command-line option, -c, telling it which file contains the edit definitions. So it is called like this (assuming we've called the program edit_files:
$ edit_files -c edit_definitions.txt < your_input_file > your_output_file
And here's the code.
#!/usr/bin/perl
use strict;
use warnings;
use Getopt::Std;
my %opts;
getopts('e:', \%opts);
my %edits = read_edits($opts{e});
while (<>) {
chomp;
my ($key, $val) = split /:/, $_, 2; #/ stop faulty syntax highlight
if (!exists $edits{$key}) {
print "$_\n";
next;
}
my $edit = $edits{$key};
if ($edit->[0] eq 'add') {
print "$_$edit->[1]\n";
} elsif ($edit->[0] eq 'del') {
$val =~ s/$_:// for split /:/, $edit->[1]; #/
print "$key:$val\n";
} elsif ($edit->[0] eq 'rpl') {
print "$key:$edit->[1]\n";
} else {
warn "$edit->[0] is an invalid edit type\n";
next;
}
}
sub read_edits {
my $file = shift;
open my $edit_fh, '<', $file or die $!;
my %edits;
while (<$edit_fh>) {
chomp;
# Remove comments
s/\s*#.*//; #/
my ($type, $key, $val) = split /:/, $_, 3; #/
$edits{$key} = [ $type, $val ];
}
}

MD5 hexdigest verification with a string

I am having a problem comparing the result from the file_md5_hex( $dir ) subroutine with a string read from a file.
When I print they are both the same, but when I compare them in a if I get all the time equal regardless of the value they have.
elsif ( -f $dir )
{
if($dir ne "$mydir.txt" && $dir ne "log.txt")
{
my $filename = "$mydir.txt";
open(my $fh, '<:encoding(UTF-8)', $filename)
or die "Could not open file '$filename' $!";
print FILE "$dir -> ";
while (my $row = <$fh>)
{
chomp($row);
if($row eq $dir)
{
my $hash = <$fh>;
chomp($hash);
print FILE "$hash = ";
break;
}
}
close $fh;
my $md5 = file_md5_hex( $dir );
print FILE "$md5\n";
print FILE ref($md5);
print FILE ref($hash);
if( $md5 eq $hash )
{
print FILE "Hash ok!\n";
}
else
{
print FILERESULT "In $mydir file $dir is corrupted. Correct is $hash, calculated is $md5\n";
print FILE "Hash Nok!\n";
}
}
}
In the log file I see that the 2 values $md5 and $hash are the same or different (depending on the case I simulate) but when I verify the program sees them as always equal. I think there might be a problem with the types of data but I don't know how to fix it.
use strict to detect errors with variable names and scopes.
$hash is not defined on if( $md5 eq $hash ) because my $hash = <$fh>; is out of scope.
Declare my $hash before while (my $row = <$fh>) and set the value with $hash = <$fh>;
http://perldoc.perl.org/functions/my.html

Why would my if(-f ) not be working?

When initially checking if ARGV[0] is a file or directory, it worked fine with accurate results. Then further down into sub files I try it again and it doesnt return anything. This may seem like a small silly question but Im a student and help on programming on the weekends is scarce. Sometimes a new set of eyes can help.Thanks in advance.
#!/usr/bin/perl -w
my %hash;
my $args = #ARGV;
my $dh = $ARGV[0];
if ( -f $dh ) {
words($dh);
} elsif ( -d $dh ) {
files($dh);
}
sub words {
open( my $file, '<', $_[0] ) or die 'cant open file';
while ( my $line = <$file> ) {
chomp $line;
#words = split( /\s+/, $line );
foreach $word (#words) {
$word =~ tr/A-Z/a-z/;
$hash{$word}++;
}
}
foreach $key ( keys %hash ) {
print $key. " " . $hash{$key} . "\n";
}
}
sub files {
opendir( DH, $_[0] );
my #paths = grep !/^\./, readdir(DH);
closedir(DH);
foreach (#paths) {
if ( -f $_ ) {
print $_. "\n";
}
}
}
You're missing path to your file,
if (-f "$_[0]/$_") ..
or to make it less obscure,
sub files{
my ($path) = #_;
opendir(my $DH, $path);
my #paths = grep !/^\./, readdir($DH);
closedir($DH);
foreach (#paths) {
if (-f "$path/$_") {
print "$_\n";
}
}
}
As has already been stated, the return values of readdir contain just the basename. Therefore, to do file tests, you must either chdir or include the path info explicitly.
if (-f "$_[0]/$_") {
One alternative solution is to use Path::Class or some similar module for doing Cross-platform path specification manipulation.
The following is your script rewritten using this module:
use strict;
use warnings;
use Path::Class;
my $path = shift // die "Usage: $0 <Dir or File>\n";
words($path) if -f $path;
files($path) if -d $path;
sub words {
my $file = file(shift);
my %count;
$count{ lc($_) }++ for split ' ', $file->slurp;
for my $key ( keys %count ) {
printf "%s %s\n", $key, $count{$key};
}
}
sub files {
my $dir = dir(shift);
for ( $dir->children ) {
next if $_->is_dir;
print "$_\n", $_->basename;
}
}

Unable to find it out duplicate - perl

I am traversing all files to get the desired one in some directory tree recursively, as soon as i am getting that files i doing some operation on them but before doing the operation i need to check whether i have performed operation on this file or not if yes then don't do it again else continue :
But the prob is, i am unable to find the way to check the condition :(
Here is my code :
use strict;
use warnings;
use autodie;
use File::Find 'find';
use File::Spec;
use Data::Printer;
my ( $root_path, $id ) = #ARGV;
our $anr_name;
opendir my ($dh), $root_path;
my #dir_list = grep -d, map File::Spec->catfile( $root_path, $_ ), grep { not /\A\.\.?\z/ } readdir $dh;
closedir $dh;
my $count;
for my $dir (#dir_list) {
find(
sub {
return unless /traces[_d]*/;
my $file = $_;
my #all_anr;
#print "$file\n\n";
my $file_name = $File::Find::name;
open( my $fh, "<", $file ) or die "cannot open file:$!\n";
my #all_lines = <$fh>;
my $i = 0;
foreach my $check (#all_lines) {
if ( $i < 10 ) {
if ( $check =~ /Cmd line\:\s+com\.android\..*/ ) {
$anr_name = $check;
my #temp = split( ':', $anr_name );
$anr_name = $temp[1];
push( #all_anr, $anr_name );
#print "ANR :$anr_name\n";
my $chk = check_for_dublicate_anr(#all_anr);
if ( $chk eq "1" ) {
# performed some action
}
}
$i++;
} else {
close($fh);
last;
}
}
},
$dir
);
}
sub check_for_dublicate_anr {
my #anrname = #_;
my %uniqueAnr = ();
foreach my $item (#anrname) {
unless ( $uniqueAnr{$item} ) {
# if we get here, we have not seen it before
$uniqueAnr{$item} = 1;
return 1;
}
}
}
You can simplify things with Path::Class and Path::Class::Rule:
use 5.010;
use warnings;
use Path::Class;
use Path::Class::Rule;
my $root = ".";
my #dirs = grep { -d $_ } dir($root)->children();
my $iter = Path::Class::Rule->new->file->name(qr{traces[_d]*})->iter(#dirs);
my $seen;
while ( my $file = $iter->() ) {
for ( $file->slurp( chomp => 1 ) ) {
next unless /Cmd line:\s+(com\.android\.\S*)/;
do_things( $file, $1 ) unless $seen->{$1}++;
}
}
sub do_things {
my ( $file, $str ) = #_;
say "new $str in the $file";
}

Use of uninitialized value within XXXX in concatenation (.) or string at image_magick.pl line XX

I wrote a program to compare the image files of two folders(having 1000 files each) with some logic (see this SO question).
While executing it is comparing successfully until 900 images but then it gives an error like Use of uninitialized value within #tfiles2 in concatenation (.) or string at C:\dropbox\Image_Compare\image_magick.pl line 55 (#3).
And then I get a popup error like Perl Command Line Interpreter has stopped working, so I close the program.
My code is as follows:
#!/usr/bin/perl
use Image::Magick;
no warnings 'uninitialized';
use warnings;
use diagnostics;
#use strict;
use List::Util qw(first);
my $directory1="C:/dropbox/Image_Compare/folder1";
opendir(DIR, $directory1) or die "couldn't open $directory1: $!\n";
my #files1 = grep { (!/^\./) && -f "$directory1/$_" } readdir(DIR);
closedir DIR;
print #files1;
print 'end of files1';
my $directory2="C:/dropbox/Image_Compare/folder2";
opendir(DIR, $directory2) or die "couldn't open $directory2: $!\n";
my #files2= grep { (!/^\./) && -f "$directory2/$_" } readdir(DIR);
closedir DIR;
print #files2;
print 'end of files2';
print $files1[0];
foreach my $fils2 (#files2)
{
$g1 = Image::Magick->new;
$g2 = Image::Magick->new;
$temp1 = $g1->Read( filename=>"C:/dropbox/Image_Compare/folder1/".$files1[0]."");
$temp1 = $g2->Read( filename=>"C:/dropbox/Image_Compare/folder2/".$fils2."");
$g3 = $g1->Compare( image=>$g2, metric=>'AE' ); # compare
$error1 = $g3->Get( 'error' );
#print $error1;
if ($error1 == '0')
{
print "Matching image is:";
print $fils2 . "\n";
my $tdirectory2="C:/dropbox/Image_Compare/folder2";
opendir(DIR, $tdirectory2) or die "couldn't open $directory2: $!\n";
my #tfiles2 = grep { (!/^\./) && -f "$tdirectory2/$_" } readdir(DIR);
closedir DIR;
#my $index = firstidx { $_ eq'"' .$fils2.'"' } #tfiles2;
my $index = first { $tfiles2[$_] eq $fils2} 0..$#tfiles2;
#print $fils2;
print $index;
my $i=0;
foreach my $fils1 (#files1)
{
print 'ganesh';
print $files1[$i];
print $tfiles2[$index];
print 'gowtham'; print "<br />";
#print #tfiles2;
$g4 = Image::Magick->new;
$g5 = Image::Magick->new;
$temp2 = $g4->Read( filename=>"C:/dropbox/Image_Compare/folder1/".$files1[$i]."");
$temp2 = $g5->Read( filename=>"C:/dropbox/Image_Compare/folder2/".$tfiles2[$index]."");
$g6 = $g4->Compare( image=>$g5, metric=>'AE' ); # compare
$error2 = $g6->Get( 'error' );
$i++;
$index++;
if ($error2 == '0') {}
else {print "Image not matching:"; print $tfiles2[$index]; last;}
#if ($i == '800') {last;}
}
last
}
}
Can anyone please help, where i am doing a mistake.
Folder 1 file names: 0025.bmp to 1051.bmp;
Folder 2 file names: 0000.bmp to 1008.bmp;
Thanks
Ganesh
I don't know which the offending line is, but one of these is likely to be the candidate:
$temp2 = $g5->Read( filename=>"C:/dropbox/Image_Compare/folder2/".$tfiles2[$index]."");
or
else {print "Image not matching:"; print $tfiles2[$index]; last;}
Do note that you increment $index whether or not it is inside the array bounds. You do not check for the condition $index > $#tfiles, which should break the loop.
You might want to assert that both input arrays contain >> 900 elements, by printing the length like print "length: ", scalar #array, "\n";.
You can test at which index the undefined error actually happens by testing for definedness of the elements in the arrays:
if (not defined $tfiles[$index] or not defined $files1[$i]) {
die "There was an undefined element at index=$index, i=$i";
}
But then again, the offset between $i, and $index is constant (as mentioned in my answer), so you don't have to actually carry two variables.
A simple comparator subroutine could make your code more readable, thus aiding debugging (see procedural programming).
# return true if matching, false otherwise.
sub compare_images {
my ($file1, $file2) = #_;
my $image1 = Image::Magick->new;
$image1->Read(filename => $file1);
my $image2 = Image::Magick->new;
$image2->Read(filename => $file2);
my $result = $image1->Compare(image => $image2, metric => 'AE')->Get('error');
# free memory
undef $image1;
undef $image2;
return 0 == $result;
}
called like
my $image_root = "C:/dropbox/Image_Compare";
my ($folder1, $folder2) = qw(folder1 folder2);
unless (compare_images("$image_root/$folder1/$files1[$i]",
"$image_root/$folder2/$tfiles[$index]")) {
print "Images not matching at index=$index, i=$i\n";
print "filename: $tfiles[$index]\n";
last;
}
You could read your directories like
sub get_images_from_dir {
my ($dirname) = #_;
-d $dirname or die qq(The path "$dirname" doesn't point to a directory!);
opendir my $dir => $dirname or die qq(Can't open "$dirname": $!);
my #files = grep {!/^\./ and -f "$dirname/$_"} readdir $dir;
closedir $dir;
unless (#files) { die qq(There were no interesting files in "$dirname".) }
return #files;
}
Steps like these make code more readable and make it easy to insert checks.