Related
I have a standardized way of writing comments before and after a function.
For example before declaring any function I write,
!---------------------------
! NAME_OF_FUNC (no)
!---------------------------
where no is the nth function in a given file containing multiple functions.
I know that a function e.g begins with (Fortran convention) either subroutine NAME_OF_SUB or function NAME_OF_FUNC. Hence, my end result would be
!---------------------------
! NAME_OF_FUNC (no)
!---------------------------
function NAME_OF_FUNC(...)
end function
!---------------------------
Can somebody show an example of how to write a bash script or in any other scripting language a code that can go through all my source files and the standard convention I just showed an example of?
Here is an example in Perl. It does not take backup before overwriting (I would recommend that you try to improve this script and add backup functionality). It also does not add the end of subroutine marker. But it would easy to add that functionality, please try. It also assumes that you want to modify all *.f95 files in the current directory and all its sub directories:
use feature qw(say state);
use strict;
use warnings;
use File::Find::Rule;
my #files = File::Find::Rule->new->name('*.f95')->in('.');
for my $fn (#files) {
open ( my $fh, '<', $fn ) or die "Could not open file '$fn': $!";
my $txt = do {local $/; <$fh>};
close $fh;
process_txt( \$txt );
save_txt( $fn, \$txt );
}
sub save_txt {
my ( $fn, $txt ) = #_;
open ( my $fh, '>', $fn ) or die "Could not open file '$fn': $!";
print $fh $$txt;
close $fh;
}
sub process_txt {
my ( $txt ) = #_;
my $i = 1;
$$txt =~ s/^(.*(?i:function|subroutine)\s+)([a-zA-Z_]+)(\s*\(.*$)/
do_substitution($1, $2, $3, $i++)/egmx;
}
sub do_substitution {
my ( $head, $name, $end, $i ) = #_;
my $line = $head . $name . $end;
$line =~ s/\s+$//;
my $N = length $line;
my $cline = '!' . '-' x $N;
my $mline = '! ' . $name;
my $snum = "($i)";
my $M = (length $mline) + (length $snum);
my $mspc = ($N > $M) ? (' ' x ($N-$M)) : ' ';
$mline = $mline . $mspc . $snum;
my $new_txt = join "\n", $cline, $mline, $cline, $line;
return $new_txt;
}
I am trying to execute the open source code which finds the list of tables involved in SQL.
I am working on Retrieve table names from Oracle queries.
I understood the expressions and commands to some extent and tried it.
Details of my execution:
GetTable.pl file
same as in the link
test.sql file
I didn't use the one in link. Instead I had only a single SQL for testing.
SELECT emp_name FROM load_tables.temp;
Executed in Strawberry Perl
I tried the following
$ perl GetTable.pl
Usage : GetTable <sql query file>
$ perl test.sql
Can't locate object method "FROM" via package "load_tables" (perhaps you forgot to load "load_tables"?) at test.sql line 1
Can someone help me in executing it? I'm not sure if there is problem with code as I could see two people have executed successfully.
Perl code
#!/usr/bin/perl
use warnings;
#Function which gets the table names and formats and prints them.
sub printTable {
my $tab = shift;
$tab =~ s/,\s+/,/g;
$tab =~ s/\s+,/,/g;
my #out = split( /,/, $tab );
foreach ( #out ) {
$_ =~ s/ .*//;
print $opr, $_, "\n";
}
}
# Function which gets the indivdual queries and separtes the table
# names from the queries. Sub-Queries, co-related queries, etc..
# will also be handled.
sub process {
local $opr;
my $line = shift;
$line =~ s/\n/ /g;
if ( $line =~ m/^\s*(select|delete)/i ) {
if ( $line =~ m/^\s*select/i ) {
$opr = "SELECT: ";
}
else {
$opr = "DELETE: ";
}
if ( $line =~ m/from.*where/i ) {
while ( $line =~ m/from\s+(.*?)where/ig ) {
&printTable( $1 );
}
}
elsif ( $line =~ m/from.*;/i ) {
while ( $line =~ m/from\s+(.*);/ig ) {
&printTable( $1 );
}
}
}
elsif ( $line =~ m/^\s*update\s+(\w+)\s+/i ) {
$opr = "UPDATE: ";
&printTable( $1 );
}
elsif ( $line =~ m/^\s*insert\s+into\s+(\w+)\s+/i ) {
$opr = "INSERT: ";
&printTable( $1 );
}
}
#The main function which reads the files and reads the
#query into a variable and sends it to process function.
if ( #ARGV != 1 ) {
print "Usage: GetTable <sql query file>\n";
exit 1;
}
open QFILE, $ARGV[0] or die "File $ARGV[0]: $! \n";
my $flag = 0;
my $query = "";
my $conds = "select|insert|update|delete";
while ( <QFILE> ) {
next if ( /^$/ );
if ( $flag == 1 ) {
$query .= $_;
if ( /;\s*$/ ) {
$flag = 0;
&process( $query );
}
}
elsif ( /^\s*($conds).*;\s*/i ) {
&process( $_ );
}
elsif ( /^\s*($conds)/i ) {
$flag = 1;
$query = $_;
}
}
close QFILE;
Two important skills to learn as a programmer are a) accuracy in following instructions and b) reading the error message carefully.
You started by running GetTable.pl. But that program requires a parameter (the name of an SQL file to analyse) and the error message tried to tell you that.
I don't know why, but instead of doing what the error message told you to do (which would have been to run perl GetTable.pl test.sql) you decided to ask Perl to run your SQL file.
The second error message you got was the Perl compiler trying to make sense of the SQL that you asked it to run. But the Perl compiler doesn't understand SQL, it understands Perl. So it's no surprise that it got confused.
To fix it, do what your first error message suggested—run the command
$ perl GetTable.pl test.sql
<>
while running a perl script in unix , which works perfectly in windows strawberry, i am getting following error:
cant locate object method "new" via package "Text::CSV"
Any insights to identify this is highly appreciated
Scripts:
#!/usr/bin/perl
use strict;
use warnings;
use Net::LDAP;
use Text::CSV;
use Net::LDAP::E#ntry;
use File::Basename;
use File::chmod;
use Config::Tiny;
use File::Copy;
use Text::Trim;
use Data::Dumper qw(Dumper);
use Net::LDAP::Util qw(ldap_error_text);
use Net::LDAP::Constant;
my $config = Config::Tiny->read('config.ini');
#Variable Declaration section
my ($bindhost,$port,$bindpwd,$binddn,$base_search,$ldap,$customerCode,$logDir,$entry,$result,$csv,$file,$line,$data,$cn,$dn,$entry2,$start_timestamp,$new,$u,$ct,$old,$logfile,$max,$stop_timestamp);
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=localtime(time);
$start_timestamp = sprintf ( "%04d%02d%02d %02d:%02d:%02d",$year+1900,$mon+1,$mday,$hour,$min,$sec);
foreach my $section (keys %{$config}) {
#LDAP Binding Connectivity variables declaration
$bindhost = $config->{$section}->{'ldap_host'};
$port = $config->{$section}->{'ldap_port'};
$bindpwd = $config->{$section}->{'ldap_password'};
$binddn = $config->{$section}->{'ldap_user'};
$base_search = $config->{$section}->{'ldap_customers_ou_dn'};
$logDir = $config->{$section}->{'log_dir'};
# connect to the ldap server
my $ldap = Net::LDAP->new($bindhost,port=>$port,timeout=>240) or die "Could not bind to ldap server: $! - $#\n";
$result = $ldap->bind
(
dn => trim($binddn), password=>trim($bindpwd)
);
#Open Script directory over here
opendir(DIR, ".");
my #files = grep(/\.csv$/,readdir(DIR));
closedir(DIR);
$csv = Text::CSV->new({ sep_char => ',' });
#print "\n Script starts processing for the timings $start_timestamp";
#Visit each .csv file by checking its naming convention over here
my $fileCt = 0;
if($file=$ARGV[0]){
print "\n Script starts processing for the timings $start_timestamp";
$ct = 1;
open($data, '<', $file) or die "Could not open given file \n";
open($logfile, '>>', 'logfile.txt');
print $logfile "Script started running for file $file at ".$start_timestamp."\n";
close $logfile;
while ($line = <$data>){
if ($csv->parse($line)) {
my #fields = $csv->fields();
$customerCode = $fields[0];
$result = $ldap->search(
base => "$base_search",
filter => "(&(customerCode=$customerCode))",
);
die ldap_error_text($result->code) if $result->code;
$max = $result->count;
if($max == 0) {
open($logfile, '>>', 'logfile.txt');
print $logfile "This customerCode $customerCode was not found in LDAP and was not reset\n";
close $logfile
}
else {
open($logfile, '>>', 'logfile.txt');
print $logfile "This customerCode $customerCode was found in LDAP and is reset\n";
close $logfile
}
for (my $index = 0 ; $index < $max ; $index++) {
my $entry = $result->entry($index);
$u = ${$entry->get('uid')}[0];
$dn = "uid=$u,$base_search";
}
my #all = ();
#all = trim($result->entries);
foreach $entry (#all){}
$entry = Net::LDAP::Entry->new;
$entry->dn($dn);
$entry->replace(
'cn' => " ",
'userPassword'=> "",
'challengeQuestion'=> "",
'challengeAnswer'=> "",
'ctscPasswordCreationDate'=> "",
'ctscPasswordExpirationDate'=> "",
'ctscPasswordHistory'=> "",
'ctscPasswordResetAttempts'=> "",
'ctscPasswordLockoutEnable'=> "",
'ctscLastResetDate'=> "",
'ctscFailedLoginCount'=> "",
);
$entry->update ($ldap);
$old = ${$entry->get('cn')}[0];
$old = ${$entry->get('userPassword')}[0];
$old = ${$entry->get('challengeQuestion')}[0];
$old = ${$entry->get('challengeAnswer')}[0];
$old = ${$entry->get('ctscPasswordCreationDate')}[0];
$old = ${$entry->get('ctscPasswordExpirationDate')}[0];
$old = ${$entry->get('ctscPasswordHistory')}[0];
$old = ${$entry->get('ctscPasswordResetAttempts')}[0];
$old = ${$entry->get('ctscPasswordLockoutEnable')}[0];
$old = ${$entry->get('ctscLastResetDate')}[0];
$old = ${$entry->get('ctscFailedLoginCount')}[0];
$entry2 = $entry->clone; # copies entry
$ldap->modify($dn, replace => {'cn' => "" });
$ldap->modify($dn, replace => {'userPassword' => "" });
$ldap->modify($dn, replace => {'challengeQuestion' => "" });
$ldap->modify($dn, replace => {'challengeAnswer' => "" });
$ldap->modify($dn, replace => {'ctscPasswordCreationDate' => "" });
$ldap->modify($dn, replace => {'ctscPasswordExpirationDate' => "" });
$ldap->modify($dn, replace => {'ctscPasswordHistory' => "" });
$ldap->modify($dn, replace => {'ctscPasswordResetAttempts' => "" });
$ldap->modify($dn, replace => {'ctscPasswordLockoutEnable' => "" });
$ldap->modify($dn, replace => {'ctscLastResetDate' => "" });
$ldap->modify($dn, replace => {'ctscFailedLoginCount' => "" });
}
else {
warn "Line could not be parsed: $line\n";
}
$ct++;
} #End while loop
my ($sec1,$min1,$hour1,$mday1,$mon1,$year1,$wday1,$yday1,$isdst1)=localtime(time);
$stop_timestamp = sprintf ( "%04d%02d%02d %02d:%02d:%02d",$year1+1900,$mon1+1,$mday1,$hour1,$min1,$sec1);
print "\n Script ends Here for the timings - $stop_timestamp ";
open($logfile, '>>', 'logfile.txt');
print $logfile "Processing stopped at ".$stop_timestamp."\n";
close $logfile;
close $data;
} #if file pattern checking loop ends
else {
print "\n Please provide a .csv file as an input";
}
}
CSV.pm:
use Text::CSV;
my #rows;
my $csv = Text::CSV->new ( { binary => 1 } ) # should set binary attribute.
or die "Cannot use CSV: ".Text::CSV->error_diag ();
open my $fh, "<:encoding(utf8)", "test.csv" or die "test.csv: $!";
while ( my $row = $csv->getline( $fh ) ) {
$row->[2] =~ m/pattern/ or next; # 3rd field should match
push #rows, $row;
}
$csv->eof or $csv->error_diag();
close $fh;
$csv->eol ("\r\n");
open $fh, ">:encoding(utf8)", "new.csv" or die "new.csv: $!";
$csv->print ($fh, $_) for #rows;
close $fh or die "new.csv: $!";
#
# parse and combine style
#
$status = $csv->combine(#columns); # combine columns into a string
$line = $csv->string(); # get the combined string
$status = $csv->parse($line); # parse a CSV string into fields
#columns = $csv->fields(); # get the parsed fields
$status = $csv->status (); # get the most recent status
$bad_argument = $csv->error_input (); # get the most recent bad argument
$diag = $csv->error_diag (); # if an error occured, explains WHY
$status = $csv->print ($io, $colref); # Write an array of fields
# immediately to a file $io
$colref = $csv->getline ($io); # Read a line from file $io,
# parse it and return an array
# ref of fields
$csv->column_names (#names); # Set column names for getline_hr ()
$ref = $csv->getline_hr ($io); # getline (), but returns a hashref
$eof = $csv->eof (); # Indicate if last parse or
# getline () hit End Of File
$csv->types(\#t_array); # Set column types
I don't know what your second block of code is for. It looks like you copied the SYNOPSIS from the CPAN page of Text::CSV.
However, in your program you have a use TEXT::CSV and then you get this error message:
cant locate object method "new" via package "Text::CSV"
That error message is a dead givaway.
You don't have Text::CSV installed on your Unix box. Install it from CPAN.
Iam stuck with this problem (searching and testing still failed).
I using codeigniter (newbie). I dont know where the problem coz this error not showing.
A PHP Error was encountered
Severity: 4096
Message: Object of class CI_DB_mysql_result could not be converted to string
Filename: controllers/bpjs_kesehatan.php
Line Number: 627
A PHP Error was encountered
Severity: Warning
Message: Cannot modify header information - headers already sent by (output started at E:\xampp\htdocs\csi\system\core\Exceptions.php:185)
Filename: core/Common.php
Line Number: 442
A Database Error Occurred
The query you submitted is not valid.
Filename: E:\xampp\htdocs\csi\system\database\DB_driver.php
Line Number: 257
my controller
function laporan_form34()
{
$bagianWhere = "";
if (isset($_POST['check_nik']))
{
$nik = $this->input->post('nik');
if (empty($bagianWhere))
{
$bagianWhere .= "bk.nik like '%$nik%'";
}
}
if (isset($_POST['check_npp']))
{
$npp = $this->input->post('npp');
if (empty($bagianWhere))
{
$bagianWhere .= "b.npp = '$npp'";
}
else
{
$bagianWhere .= " AND b.npp = '$npp'";
}
}
if (isset($_POST['check_kk']))
{
$kk = $this->input->post('kk');
if (empty($bagianWhere))
{
$bagianWhere .= "bk.no_kk like '%$kk%'";
}
else
{
$bagianWhere .= "AND bk.no_kk like '%$kk%'";
}
}
if (empty($bagianWhere))
{
$this->session->set_flashdata('flash_messages', 'ERROR : Minimal salah satu kriteria harus diisi !');
redirect( base_url() . 'bpjs_kesehatan/form34');
}
else
{
$result_criteria = $this->app_model->manualQuery("select b.nik,b.hubkel
from biodata_karyawan bk left join bpjs b
on b.nik = bk.nik where bk.status_karyawan = 'Aktif' and " . $bagianWhere ." order by b.nik");
}
//show data to view
$bc['dt_karyawan'] = $this->db->query("$result_criteria");
$this->load->view('bpjs_kesehatan/laporan_form34',$bc);
}
My View
foreach($dt_karyawan->result_array() as $row)
{
$hubkel = $row['hubkel'];
$nik = $row['nik'];
if($hubkel=='pegawai')
{
//HUBKEL PEGAWAI
$query_pegawai = "select bk.no_kk as 'no_2',bk.nik as 'no_3',bk.nama as 'no_4',
'1' as 'no_5',bk.tempat_lahir as 'no_6',bk.tgl_lahir as 'no_7',bk.jenis_kelamin as 'no_8','1' as 'no_9',
bk.nama_ibu as 'no_10',bk.alamat as 'no_11',bk.rt as 'no_12',bk.rw as 'no_13',bk.kodepos as 'no_14',
bk.kode_kecamatan as 'no_15',bk.nama_kecamatan as 'no_16',
bk.kode_desa as 'no_17',bk.nama_desa as 'no_18',b.kode_faskes as 'no_19',b.nama_faskes as 'no_20',
b.kode_faskes_gigi as 'no_21',b.nama_faskes_gigi as 'no_22',bk.no_hp as 'no_23',
bk.email as 'no_24',b.npp as 'no_25','security' as 'no_26','2' as 'no_27',b.kelas_rawat as 'no_28',
bk.tgl_masuk as 'no_29',
'-' as 'no_30',bk.kewarganegaraan as 'no_31',b.asuransilainnya_nopolis as 'no_32',
b.asuransilainnya_namaasuransi as 'no_33',b.no_npwp as 'no_34',b.no_passport as 'no_35'
from biodata_karyawan bk left join bpjs b on bk.nik=b.nik where b.nik='$nik'";
}
if($hubkel=='istri')
{
//HUBKEL ISTRI
$query_istri = "select bk.no_kk_pasangan as 'no_2',bk.nik as 'no_3',bk.sp_nama_ibu as 'no_4',
'3' as 'no_5',bk.sp_tmptlhr_ibu as 'no_6',bk.sp_tgllhr_ibu as 'no_7','2' as 'no_8','2' as 'no_9',
bk.sp_namaibukandung_ibu as 'no_10',bk.alamat_pasangan as 'no_11',bk.rt_pasangan as 'no_12',
bk.rw_pasangan as 'no_13',bk.kodepos_pasangan as 'no_14',
bk.kode_kecamatan_pasangan as 'no_15',bk.nama_kecamatan_pasangan as 'no_16',
bk.kode_desa_pasangan as 'no_17',bk.nama_desa_pasangan as 'no_18',b.kode_faskes as 'no_19',
b.nama_faskes as 'no_20',
b.kode_faskes_gigi as 'no_21',b.nama_faskes_gigi as 'no_22','-' as 'no_23',
'-' as 'no_24',b.npp as 'no_25','-' as 'no_26','-' as 'no_27',b.kelas_rawat as 'no_28','-' as 'no_29',
'-' as 'no_30',bk.kewarganegaraan as 'no_31',b.asuransilainnya_nopolis as 'no_32',
b.asuransilainnya_namaasuransi as 'no_33',b.no_npwp as 'no_34',b.no_passport as 'no_35'
from biodata_karyawan bk left join bpjs b on bk.nik=b.nik where b.nik='$nik'";
}
if($hubkel=='suami')
{
//HUBKEL SUAMI
$query_suami = "select bk.no_kk_pasangan as 'no_2',bk.nik as 'no_3',bk.sp_nama_ayah as 'no_4',
'2' as 'no_5',bk.sp_tmptlhr_ayah as 'no_6',bk.sp_tgllhr_ayah as 'no_7','3' as 'no_8','2' as 'no_9',
bk.sp_namaayahkandung_ibu as 'no_10',bk.alamat_pasangan as 'no_11',bk.rt_pasangan as 'no_12',
bk.rw_pasangan as 'no_13',bk.kodepos_pasangan as 'no_14',
bk.kode_kecamatan_pasangan as 'no_15',bk.nama_kecamatan_pasangan as 'no_16',
bk.kode_desa_pasangan as 'no_17',bk.nama_desa_pasangan as 'no_18',b.kode_faskes as 'no_19',
b.nama_faskes as 'no_20',
b.kode_faskes_gigi as 'no_21',b.nama_faskes_gigi as 'no_22','-' as 'no_23',
'-' as 'no_24',b.npp as 'no_25','-' as 'no_26','-' as 'no_27',b.kelas_rawat as 'no_28','-' as 'no_29',
'-' as 'no_30',bk.kewarganegaraan as 'no_31',b.asuransilainnya_nopolis as 'no_32',
b.asuransilainnya_namaasuransi as 'no_33',b.no_npwp as 'no_34',b.no_passport as 'no_35'
from biodata_karyawan bk left join bpjs b on bk.nik=b.nik where b.nik='$nik'";
}
if(!empty($query_pegawai))
{
foreach($query_pegawai->result() as $data)
{
echo '<tr align="center">';
echo '<td>'.$no.'</td>';
echo '<td>'.$kutip.$data->no_2.'</td>';
echo '<td>'.$kutip.$data->no_3.'</td>';
echo '<td>'.$data->no_4.'</td>';
echo '<td>'.$data->no_5.'</td>';
echo '<td>'.$data->no_6.'</td>';
echo '<td>'.$kutip.$data->no_7.'</td>';
echo '<td>'.$data->no_8.'</td>';
echo '<td>'.$data->no_9.'</td>';
echo '<td>'.$data->no_10.'</td>';
echo '<td>'.$data->no_11.'</td>';
echo '<td>'.$kutip.$data->no_12.'</td>';
echo '<td>'.$kutip.$data->no_13.'</td>';
echo '<td>'.$kutip.$data->no_14.'</td>';
echo '<td>'.$kutip.$data->no_15.'</td>';
echo '<td>'.$data->no_16.'</td>';
echo '<td>'.$kutip.$data->no_17.'</td>';
echo '<td>'.$data->no_18.'</td>';
echo '<td>'.$kutip.$data->no_19.'</td>';
echo '<td>'.$data->no_20.'</td>';
echo '<td>'.$data->no_21.'</td>';
echo '<td>'.$data->no_22.'</td>';
echo '<td>'.$kutip.$data->no_23.'</td>';
echo '<td>'.$data->no_24.'</td>';
echo '<td>'.$kutip.$data->no_25.'</td>';
echo '<td>'.$data->no_26.'</td>';
echo '<td>'.$data->no_27.'</td>';
echo '<td>'.$data->no_28.'</td>';
echo '<td>'.$kutip.$data->no_29.'</td>';
echo '<td>'.$data->no_30.'</td>';
echo '<td>'.$data->no_31.'</td>';
echo '<td>'.$kutip.$data->no_32.'</td>';
echo '<td>'.$data->no_33.'</td>';
echo '<td>'.$kutip.$data->no_34.'</td>';
echo '<td>'.$kutip.$data->no_35.'</td>';
echo '</tr>';
}
}
if(!empty($query_istri))
{
foreach($query_istri->result() as $data)
{
echo '<tr align="center">';
echo '<td>'.$no.'</td>';
echo '<td>'.$kutip.$data->no_2.'</td>';
echo '<td>'.$kutip.$data->no_3.'</td>';
echo '<td>'.$data->no_4.'</td>';
echo '<td>'.$data->no_5.'</td>';
echo '<td>'.$data->no_6.'</td>';
echo '<td>'.$kutip.$data->no_7.'</td>';
echo '<td>'.$data->no_8.'</td>';
echo '<td>'.$data->no_9.'</td>';
echo '<td>'.$data->no_10.'</td>';
echo '<td>'.$data->no_11.'</td>';
echo '<td>'.$kutip.$data->no_12.'</td>';
echo '<td>'.$kutip.$data->no_13.'</td>';
echo '<td>'.$kutip.$data->no_14.'</td>';
echo '<td>'.$kutip.$data->no_15.'</td>';
echo '<td>'.$data->no_16.'</td>';
echo '<td>'.$kutip.$data->no_17.'</td>';
echo '<td>'.$data->no_18.'</td>';
echo '<td>'.$kutip.$data->no_19.'</td>';
echo '<td>'.$data->no_20.'</td>';
echo '<td>'.$data->no_21.'</td>';
echo '<td>'.$data->no_22.'</td>';
echo '<td>'.$kutip.$data->no_23.'</td>';
echo '<td>'.$data->no_24.'</td>';
echo '<td>'.$kutip.$data->no_25.'</td>';
echo '<td>'.$data->no_26.'</td>';
echo '<td>'.$data->no_27.'</td>';
echo '<td>'.$data->no_28.'</td>';
echo '<td>'.$kutip.$data->no_29.'</td>';
echo '<td>'.$data->no_30.'</td>';
echo '<td>'.$data->no_31.'</td>';
echo '<td>'.$kutip.$data->no_32.'</td>';
echo '<td>'.$data->no_33.'</td>';
echo '<td>'.$kutip.$data->no_34.'</td>';
echo '<td>'.$kutip.$data->no_35.'</td>';
echo '</tr>';
}
}
}
the $dt_karyawan have many records. but I must selected data base on hubkel = (pegawai,suami,istri) using query again.
where my problem guys?
thanks to your time.
this code is running on a file of 200M lines at least. and this takes a lot of time
I would like to know if I can improve the runtime of this loop.
my #bin_lsit; #list of 0's and 1's
while (my $line = $input_io->getline) {
if ($bin_list[$i]) {
$line =~ s/^.{3}/XXX/;
} else {
$line =~ s/^.{3}/YYY/;
}
$output_io->appendln($line);
$i++;
}
A regex solution may be overkill here. How about replacing the if/else blocks with:
substr($line, 0, 3, $bin_list[$i] ? 'XXX' : 'YYY';
Smallest change is probably to buffer between appendln's
my #bin_lsit; #list of 0's and 1's
my $i = 0;
while (my $line = $input_io->getline) {
if ($bin_list[$i]) {
$line =~ s/^.{3}/XXX/;
} else {
$line =~ s/^.{3}/YYY/;
}
$buffer .= $line;
if ( $i % 1000 == 0 ) {
$output_io->appendln($buffer);
$buffer = '';
}
$i++;
}
if ( $buffer ne '' ) {
$output_io->appendln($buffer);
}
Are you using IO::All?
I couldn't find anything else with appendln...
Replacing this:
my $input_io = io 'tmp.this';
my $output_io = io 'tmp.out';
while (my $line = $input_io->getline ) {
$output_io->appendln($line);
}
With this:
open(IFH, 'tmp.this');
open(OFH, '>>tmp.out');
while (my $line = <IFH> ) {
print OFH $line;
}
close IFH;
close OFH;
Is quite a bit faster (1 sec vs 23 in my test case).