Perltidy autoformat hashref as parameter - perl

I have the following code snippet:
my $obj = $class->new({
schema => $schema,
reminder => $reminder,
action => $action,
dt => $dt,
});
My problem is, that perltidy tries to format it into something, like this:
my $obj = $class->new(
{ schema => $schema,
reminder => $reminder,
action => $action,
dt => $dt,
}
);
I don't like the curly brace placement. Can I somehow configure perltidy to format it like the first example? (Skipping the formatting for the block is not an option. I want to format every longer hashref into that format, so it is more compact and readable)
My perltidyrc so far:
-l=79 # Max line width is 78 cols
-i=4 # Indent level is 4 cols
-ci=4 # Continuation indent is 4 cols
-st # Output to STDOUT
-se # Errors to STDERR
-vt=2 # Maximal vertical tightness
-cti=0 # No extra indentation for closing brackets
-pt=1 # Medium parenthesis tightness
-bt=1 # Medium brace tightness
-sbt=1 # Medium square bracket tightness
-bbt=1 # Medium block brace tightness
-nsfs # No space before semicolons
-nolq # Don't outdent long quoted strings
If I remove the '{}' and pass the parameters as a list, it does the right thing btw. But i have to pass a hashref.
Or could you recommend a sane way of formatting such code?

How about this option?
perltidy -lp -vt=2 -vtc=1
which yields
my $obj = $class->new( { schema => $schema,
reminder => $reminder,
action => $action,
dt => $dt,
} );
which is here http://perltidy.sourceforge.net/perltidy.html#line_break_control
Closing tokens (except for block braces) are controlled by -vtc=n, or
--vertical-tightness-closing=n, where
-vtc=0 always break a line before a closing token (default), -vtc=1
do not break before a closing token which is followed
by a semicolon or another closing token, and is not in
a list environment. -vtc=2 never break before a closing token.
EDIT
I suspect you were missing the -lp (line up parameters) option which is also needed for vertical tightness (-vt and -vtc)

The following seems to solve the above problem and works for me:
# perltidy configuration file created Thu Sep 24 15:54:07 2015
# using: -
# I/O control
--standard-error-output # -se
--nostandard-output # -nst
# Basic formatting options
--indent-columns=4 # -i=4 [=default]
--maximum-line-length=140 # -l=140
# Code indentation control
--closing-brace-indentation=0 # -cbi=0 [=default]
--closing-paren-indentation=0 # -cpi=0 [=default]
--closing-square-bracket-indentation=0 # -csbi=0 [=default]
--continuation-indentation=4 # -ci=4
--nooutdent-labels # -nola
--nooutdent-long-quotes # -nolq
# Whitespace control
--block-brace-tightness=1 # -bbt=1
--brace-tightness=1 # -bt=1 [=default]
--paren-tightness=2 # -pt=2
--nospace-for-semicolon # -nsfs
--square-bracket-tightness=1 # -sbt=1 [=default]
--square-bracket-vertical-tightness=0 # -sbvt=0 [=default]
# Comment controls
--ignore-side-comment-lengths # -iscl
--minimum-space-to-comment=2 # -msc=2
--static-side-comment-prefix="#" # -sscp="#"
--static-side-comments # -ssc
# Linebreak controls
--brace-vertical-tightness=0 # -bvt=0 [=default]
--paren-vertical-tightness=0 # -pvt=0 [=default]
--stack-closing-hash-brace # -schb
--stack-closing-paren # -scp
--stack-closing-square-bracket # -scsb
--stack-opening-hash-brace # -sohb
--stack-opening-paren # -sop
--stack-opening-square-bracket # -sosb
--want-break-before="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= + >>= ||= .= %= ^= x=" # -wbb="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= + >>= ||= .= %= ^= x="
# Blank line control
--noblanks-before-comments # -nbbc

Related

perltidy indentation on method calls with or operator

I am attempting to get perltidy to indent correctly. It works almost perfectly, but there are issues with some lines of code.
For example:
$foo = something()
or Foo->throw(
'a string which is longer than -l line length. Gets wrapped to next line, but not indented further than line above'
);
which should be:
$foo = something()
or Foo->throw(
'a string which is longer than -l line length. Gets wrapped to next line, but not indented further than line above'
);
Also, if a line break already exists, it does not get the indentation right:
$foo = something()
or Foo->throw(
'string'
);
should be:
$foo = something()
or Foo->throw(
'string'
);
Funnily enough, it gets it right if the function call contains a hashref...
The perltidyrc:
# Line
-l=78 # Max line width is 78 cols
-ole=unix # Unix line endings
# Indentation
-i=4 # Indent level is 4 cols
-ci=4 # Continuation indent is 4 cols
-dt=4 # Default tab size is 4 cols
-noll # Don't outdent long quoted strings or lines
# Comments
-iscl # Ignore inline comment (side comments) length
# Blank lines
-blbs=1 # Ensure a blank line before methods
-bbb # Ensure a blank line before blocks
-mbl=1 # Maximum consecutive blank lines
# Braces/parens/brackets
-nbl # Opening braces on same line (incl. methods)
-pt=0 # Low parenthesis tightness
-sbt=0 # Low square bracket tightness
-bt=0 # Low brace tightness
-bbt=0 # Low block brace tightness
# Semicolons
-nsfs # No space for semicolons within for loops
-nsts # No space before terminating semicolons
# Spaces / Tightness
-baao # Break after all operators
-bbao # Break before all operators
-cti=0 # No extra indentation for closing brackets
# General perltidy settings
-conv # Use as many iterations as necessary to beautify, until successive runs produce identical output (converge)
-b # Backup files and modify in-place
-se # Errors to STDERR
I've gone back and forth a lot with varying degrees of success, but not managed to get it exactly right. Any pointers?

New to Perl - Parsing file and replacing pattern with dynamic values

I am very new to Perl and i am currently trying to convert a bash script to perl.
My script is used to convert nmon files (AIX / Linux perf monitoring tool), it takes nmon files present in a directory, grep and redirect the specific section to a temp file, grep and redirect the associated timestamp to aother file.
Then, it parses data into a final csv file that will be indexed by a a third tool to be exploited.
A sample NMON data looks like:
TOP,%CPU Utilisation
TOP,+PID,Time,%CPU,%Usr,%Sys,Threads,Size,ResText,ResData,CharIO,%RAM,Paging,Command,WLMclass
TOP,5165226,T0002,10.93,9.98,0.95,1,54852,4232,51220,311014,0.755,1264,PatrolAgent,Unclassified
TOP,5365876,T0002,1.48,0.81,0.67,135,85032,132,84928,38165,1.159,0,db2sysc,Unclassified
TOP,5460056,T0002,0.32,0.27,0.05,1,5060,616,4704,1719,0.072,0,db2kmchan64.v9,Unclassified
The field "Time" (Seen as T0002 and really called ZZZZ in NMON) is a specific NMON timestamp, the real value of this timestamp is present later (in a dedicated section) in the NMON file and looks like:
ZZZZ,T0001,00:09:55,01-JAN-2014
ZZZZ,T0002,00:13:55,01-JAN-2014
ZZZZ,T0003,00:17:55,01-JAN-2014
ZZZZ,T0004,00:21:55,01-JAN-2014
ZZZZ,T0005,00:25:55,01-JAN-2014
The NMON format is very specific and can't be exploited directly without being parsed, the timestamp has to be associated with the corresponding value. (A NMON file is almost like a concatenation of numerous different csv files with each a different format, different fileds and so on.)
I wrote the following bash script to parse the section i'm interested in (The "TOP" section which represents top process cpu, mem, io stats per host)
#!/bin/bash
# set -x
################################################################
# INFORMATION
################################################################
# nmon2csv_TOP.sh
# Convert TOP section of nmon files to csv
# CAUTION: This script is expected to be launched by the main workflow
# $DST and DST_CONVERTED_TOP are being exported by it, if not this script will exit at launch time
################################################################
# VARS
################################################################
# Location of NMON files
NMON_DIR=${DST}
# Location of generated files
OUTPUT_DIR=${DST_CONVERTED_TOP}
# Temp files
rawdatafile=/tmp/temp_rawdata.$$.temp
timestampfile=/tmp/temp_timestamp.$$.temp
# Main Output file
finalfile=${DST_CONVERTED_TOP}/NMON_TOP_processed_at_date_`date '+%F'`.csv
###########################
# BEGIN OF WORK
###########################
# Verify exported var are not null
if [ -z ${NMON_DIR} ]; then
echo -e "\nERROR: Var NMON_DIR is null!\n" && exit 1
elif [ -z ${OUTPUT_DIR} ]; then
echo -e "\nERROR: Var OUTPUT_DIR is null!\n" && exit 1
fi
# Check if temp and output files already exists
if [ -s ${rawdatafile} ]; then
rm -f ${rawdatafile}
elif [ -s ${timestampfile} ]; then
rm -f ${timestampfile}
elif [ -s ${finalfile} ]; then
rm -f ${finalfile}
fi
# Get current location
PWD=`pwd`
# Go to NMON files location
cd ${NMON_DIR}
# For each NMON file present:
# To restrict to only PROD env: `ls *.nmon | grep -E -i 'sp|gp|ge'`
for NMON_FILE in `ls *.nmon | grep -E -i 'sp|gp|ge'`; do
# Set Hostname identification
serialnum=`grep 'AAA,SerialNumber,' ${NMON_FILE} | awk -F, '{print $3}' OFS=, | tr [:lower:] [:upper:]`
hostname=`grep 'AAA,host,' ${NMON_FILE} | awk -F, '{print $3}' OFS=, | tr [:lower:] [:upper:]`
# Grep and redirect TOP Section
grep 'TOP' ${NMON_FILE} | grep -v 'AAA,version,TOPAS-NMON' | grep -v 'TOP,%CPU Utilisation' > ${rawdatafile}
# Grep and redirect associated timestamps (ZZZZ)
grep 'ZZZZ' ${NMON_FILE}> ${timestampfile}
# Begin of work
while IFS=, read TOP PID Time Pct_CPU Pct_Usr Pct_Sys Threads Size ResText ResData CharIO Pct_RAM Paging Command WLMclass
do
timestamp=`grep ${Time} ${timestampfile} | awk -F, '{print $4 " "$3}' OFS=,`
echo ${serialnum},${hostname},${timestamp},${Time},${PID},${Pct_CPU},${Pct_Usr},${Pct_Sys},${Threads},${Size},${ResText},${ResData},${CharIO},${Pct_RAM},${Paging},${Command},${WLMclass} \
| grep -v '+PID,%CPU,%Usr,%Sys,Threads,Size,ResText,ResData,CharIO,%RAM,Paging,Command,WLMclass' >> ${finalfile}
done < ${rawdatafile}
echo -e "INFO: Done for Serialnum: ${serialnum} Hostname: ${hostname}"
done
# Go back to initial location
cd ${PWD}
###########################
# END OF WORK
###########################
This works as wanted and generate a main csv file (you'll see in the code that i voluntary don't keep the csv header in the file) wich is a concatenation of all parsed hosts.
But, i have a very large amount of host to treat each day (around 3000 hosts), with this current code and in worst cases, it can takes a few minutes to generate data for 1 host, multiplicated per number of hosts minutes becomes easily hours...
So, this code is really not performer enough to deal with such amount of data
10 hosts represents around 200.000 lines, which represents finally around 20 MB of csv file.
That's not that much, but i think that a shell script is probably not the better choice to manage such a process...
I guess that perl shall be much better at this task (even if the shell script could probably be improved), but my knowledge in perl is (currently) very poor, this is why i ask your help... I think that code should be quite simple to do in perl but i can't get it to work as for now...
One guy used to develop a perl script to manage NMON files and convert them to sql files (to dump these data into a database), i staged it to use its feature and with the help of some shell scripts i manage the sql files to get my final csv files.
But the TOP section was not integrated into that perl script and can't be used to that without being redeveloped.
The code in question:
#!/usr/bin/perl
# Program name: nmon2mysql.pl
# Purpose - convert nmon.csv file(s) into mysql insert file
# Author - Bruce Spencer
# Disclaimer: this provided "as is".
# Date - March 2007
#
$nmon2mysql_ver="1.0. March 2007";
use Time::Local;
#################################################
## Your Customizations Go Here ##
#################################################
# Source directory for nmon csv files
my $NMON_DIR=$ENV{DST_TMP};
my $OUTPUT_DIR=$ENV{DST_CONVERTED_CPU_ALL};
# End "Your Customizations Go Here".
# You're on your own, if you change anything beyond this line :-)
####################################################################
############# Main Program ############
####################################################################
# Initialize common variables
&initialize;
# Process all "nmon" files located in the $NMON_DIR
# #nmon_files=`ls $NMON_DIR/*.nmon $NMON_DIR/*.csv`;
#nmon_files=`ls $NMON_DIR/*.nmon`;
if (#nmon_files eq 0 ) { die ("No \*.nmon or csv files found in $NMON_DIR\n"); }
#nmon_files=sort(#nmon_files);
chomp(#nmon_files);
foreach $FILENAME ( #nmon_files ) {
#cols= split(/\//,$FILENAME);
$BASEFILENAME= $cols[#cols-1];
unless (open(INSERT, ">$OUTPUT_DIR/$BASEFILENAME.sql")) {
die("Can not open /$OUTPUT_DIR/$BASEFILENAME.sql\n");
}
print INSERT ("# nmon version: $NMONVER\n");
print INSERT ("# AIX version: $AIXVER\n");
print INSERT ("use nmon;\n");
$start=time();
#now=localtime($start);
$now=join(":",#now[2,1,0]);
print ("$now: Begin processing file = $FILENAME\n");
# Parse nmon file, skip if unsuccessful
if (( &get_nmon_data ) gt 0 ) { next; }
$now=time();
$now=$now-$start;
print ("\t$now: Finished get_nmon_data\n");
# Static variables (number of fields always the same)
##static_vars=("LPAR","CPU_ALL","FILE","MEM","PAGE","MEMNEW","MEMUSE","PROC");
##static_vars=("LPAR","CPU_ALL","FILE","MEM","PAGE","MEMNEW","MEMUSE");
#static_vars=("CPU_ALL");
foreach $key (#static_vars) {
&mk_mysql_insert_static($key);;
$now=time();
$now=$now-$start;
print ("\t$now: Finished $key\n");
} # end foreach
# Dynamic variables (variable number of fields)
##dynamic_vars=("DISKBSIZE","DISKBUSY","DISKREAD","DISKWRITE","DISKXFER","ESSREAD","ESSWRITE","ESSXFER","IOADAPT","NETERROR","NET","NETPACKET");
#dynamic_vars=("");
foreach $key (#dynamic_vars) {
&mk_mysql_insert_variable($key);;
$now=time();
$now=$now-$start;
print ("\t$now: Finished $key\n");
}
close(INSERT);
# system("gzip","$FILENAME");
}
exit(0);
############################################
############# Subroutines ############
############################################
##################################################################
## Extract CPU_ALL data for Static fields
##################################################################
sub mk_mysql_insert_static {
my($nmon_var)=#_;
my $table=lc($nmon_var);
my #rawdata;
my $x;
my #cols;
my $comma;
my $TS;
my $n;
#rawdata=grep(/^$nmon_var,/, #nmon);
if (#rawdata < 1) { return(1); }
#rawdata=sort(#rawdata);
#cols=split(/,/,$rawdata[0]);
$x=join(",",#cols[2..#cols-1]);
$x=~ s/\%/_PCT/g;
$x=~ s/\(MB\)/_MB/g;
$x=~ s/-/_/g;
$x=~ s/ /_/g;
$x=~ s/__/_/g;
$x=~ s/,_/,/g;
$x=~ s/_,/,/g;
$x=~ s/^_//;
$x=~ s/_$//;
print INSERT (qq|insert into $table (serialnum,hostname,mode,nmonver,time,ZZZZ,$x) values\n| );
$comma="";
$n=#cols;
$n=$n-1; # number of columns -1
for($i=1;$i<#rawdata;$i++){
$TS=$UTC_START + $INTERVAL*($i);
#cols=split(/,/,$rawdata[$i]);
$x=join(",",#cols[2..$n]);
$x=~ s/,,/,-1,/g; # replace missing data ",," with a ",-1,"
print INSERT (qq|$comma("$SN","$HOSTNAME","$MODE","$NMONVER",$TS,"$DATETIME{#cols[1]}",$x)| );
$comma=",\n";
}
print INSERT (qq|;\n\n|);
} # end mk_mysql_insert
##################################################################
## Extract CPU_ALL data for variable fields
##################################################################
sub mk_mysql_insert_variable {
my($nmon_var)=#_;
my $table=lc($nmon_var);
my #rawdata;
my $x;
my $j;
my #cols;
my $comma;
my $TS;
my $n;
my #devices;
#rawdata=grep(/^$nmon_var,/, #nmon);
if ( #rawdata < 1) { return; }
#rawdata=sort(#rawdata);
$rawdata[0]=~ s/\%/_PCT/g;
$rawdata[0]=~ s/\(/_/g;
$rawdata[0]=~ s/\)/_/g;
$rawdata[0]=~ s/ /_/g;
$rawdata[0]=~ s/__/_/g;
$rawdata[0]=~ s/,_/,/g;
#devices=split(/,/,$rawdata[0]);
print INSERT (qq|insert into $table (serialnum,hostname,time,ZZZZ,device,value) values\n| );
$n=#rawdata;
$n--;
for($i=1;$i<#rawdata;$i++){
$TS=$UTC_START + $INTERVAL*($i);
$rawdata[$i]=~ s/,$//;
#cols=split(/,/,$rawdata[$i]);
print INSERT (qq|\n("$SN","$HOSTNAME",$TS,"$DATETIME{$cols[1]}","$devices[2]",$cols[2])| );
for($j=3;$j<#cols;$j++){
print INSERT (qq|,\n("$SN","$HOSTNAME",$TS,"$DATETIME{$cols[1]}","$devices[$j]",$cols[$j])| );
}
if ($i < $n) { print INSERT (","); }
}
print INSERT (qq|;\n\n|);
} # end mk_mysql_insert_variable
########################################################
### Get an nmon setting from csv file ###
### finds first occurance of $search ###
### Return the selected column...$return_col ###
### Syntax: ###
### get_setting($search,$col_to_return,$separator)##
########################################################
sub get_setting {
my $i;
my $value="-1";
my ($search,$col,$separator)= #_; # search text, $col, $separator
for ($i=0; $i<#nmon; $i++){
if ($nmon[$i] =~ /$search/ ) {
$value=(split(/$separator/,$nmon[$i]))[$col];
$value =~ s/["']*//g; #remove non alphanum characters
return($value);
} # end if
} # end for
return($value);
} # end get_setting
#####################
## Clean up ##
#####################
sub clean_up_line {
# remove characters not compatible with nmon variable
# Max rrdtool variable length is 19 chars
# Variable can not contain special characters (% - () )
my ($x)=#_;
# print ("clean_up, before: $i\t$nmon[$i]\n");
$x =~ s/\%/Pct/g;
# $x =~ s/\W*//g;
$x =~ s/\/s/ps/g; # /s - ps
$x =~ s/\//s/g; # / - s
$x =~ s/\(/_/g;
$x =~ s/\)/_/g;
$x =~ s/ /_/g;
$x =~ s/-/_/g;
$x =~ s/_KBps//g;
$x =~ s/_tps//g;
$x =~ s/[:,]*\s*$//;
$retval=$x;
} # end clean up
##########################################
## Extract headings from nmon csv file ##
##########################################
sub initialize {
%MONTH2NUMBER = ("jan", 1, "feb",2, "mar",3, "apr",4, "may",5, "jun",6, "jul",7, "aug",8, "sep",9, "oct",10, "nov",11, "dec",12 );
#MONTH2ALPHA = ( "junk","jan", "feb", "mar", "apr", "may", "jun", "jul", "aug", "sep", "oct", "nov", "dec" );
} # end initialize
# Get data from nmon file, extract specific data fields (hostname, date, ...)
sub get_nmon_data {
my $key;
my $x;
my $category;
my %toc;
my #cols;
# Read nmon file
unless (open(FILE, $FILENAME)) { return(1); }
#nmon=<FILE>; # input entire file
close(FILE);
chomp(#nmon);
# Cleanup nmon data remove trainig commas and colons
for($i=0; $i<#nmon;$i++ ) {
$nmon[$i] =~ s/[:,]*\s*$//;
}
# Get nmon/server settings (search string, return column, delimiter)
$AIXVER =&get_setting("AIX",2,",");
$DATE =&get_setting("date",2,",");
$HOSTNAME =&get_setting("host",2,",");
$INTERVAL =&get_setting("interval",2,","); # nmon sampling interval
$MEMORY =&get_setting(qq|lsconf,"Good Memory Size:|,1,":");
$MODEL =&get_setting("modelname",3,'\s+');
$NMONVER =&get_setting("version",2,",");
$SNAPSHOTS =&get_setting("snapshots",2,","); # number of readings
$STARTTIME =&get_setting("AAA,time",2,",");
($HR, $MIN)=split(/\:/,$STARTTIME);
if ($AIXVER eq "-1") {
$SN=$HOSTNAME; # Probably a Linux host
} else {
$SN =&get_setting("systemid",4,",");
$SN =(split(/\s+/,$SN))[0]; # "systemid IBM,SN ..."
}
$TYPE =&get_setting("^BBBP.*Type",3,",");
if ( $TYPE =~ /Shared/ ) { $TYPE="SPLPAR"; } else { $TYPE="Dedicated"; }
$MODE =&get_setting("^BBBP.*Mode",3,",");
$MODE =(split(/: /, $MODE))[1];
# $MODE =~s/\"//g;
# Calculate UTC time (seconds since 1970)
# NMON V9 dd/mm/yy
# NMON V10+ dd-MMM-yyyy
if ( $DATE =~ /[a-zA-Z]/ ) { # Alpha = assume dd-MMM-yyyy date format
($DAY, $MMM, $YR)=split(/\-/,$DATE);
$MMM=lc($MMM);
$MON=$MONTH2NUMBER{$MMM};
} else {
($DAY, $MON, $YR)=split(/\//,$DATE);
$YR=$YR + 2000;
$MMM=$MONTH2ALPHA[$MON];
} # end if
## Calculate UTC time (seconds since 1970). Required format for the rrdtool.
## timelocal format
## day=1-31
## month=0-11
## year = x -1900 (time since 1900) (seems to work with either 2006 or 106)
$m=$MON - 1; # jan=0, feb=2, ...
$UTC_START=timelocal(0,$MIN,$HR,$DAY,$m,$YR);
$UTC_END=$UTC_START + $INTERVAL * $SNAPSHOTS;
#ZZZZ=grep(/^ZZZZ,/,#nmon);
for ($i=0;$i<#ZZZZ;$i++){
#cols=split(/,/,$ZZZZ[$i]);
($DAY,$MON,$YR)=split(/-/,$cols[3]);
$MON=lc($MON);
$MON="00" . $MONTH2NUMBER{$MON};
$MON=substr($MON,-2,2);
$ZZZZ[$i]="$YR-$MON-$DAY $cols[2]";
$DATETIME{$cols[1]}="$YR-$MON-$DAY $cols[2]";
} # end ZZZZ
return(0);
} # end get_nmon_data
It almost (i say almost because with recent NMON versions it can sometimes have some issue when no data present) does the job, and it does it much much faster that would do my shell script if i would use it for these section
This is why i think perl shall be a perfect solution.
Off course, i don't ask anyone to convert my shell script into something final in perl, but at least to give me to right direction :-)
I really thank anyone in advance for your help !
Normally i am strongly opposed to questions like this but our production systems are down and until they are fixed i do not really have all that much to do...
Here is some code that might get you started. Please consider it pseudo code as it is completely untested and probably won't even compile (i always forget some parantheses or semicolons and as i said, the actual machines that can run code are unreachable) but i commented a lot and hopefully you will be able to modify it to your actual needs and get it to run.
use strict;
use warnings;
open INFILE, "<", "path/to/file.nmon"; # Open the file.
my #topLines; # Initialize variables.
my %timestamps;
while <INFILE> # This will walk over all the lines of the infile.
{ # Storing the current line in $_.
chomp $_; # Remove newline at the end.
if ($_ =~ m/^TOP/) # If the line starts with TOP...
{
push #topLines, $_; # ...store it in the array for later use.
}
elsif ($_ =~ m/^ZZZZ/) # If it is in the ZZZZ section...
{
my #fields = split ',', $_; # ...split the line at commas...
my $timestamp = join ",", $fields(2), $fields(3); # ...join the timestamp into a string as you wish...
$timestamps{$fields(1)} = $timestamp; # ...and store it in the hash with the Twhatever thing as key.
}
# This iteration could certainly be improved with more knowledge
# of how the file looks. For example the search could be cancelled
# after the ZZZZ section if the file is still long.
}
close INFILE;
open OUTFILE, ">", "path/to/output.csv"; # Open the file you want your output in.
foreach (#topLines) # Iterate through all elements of the array.
{ # Once again storing the current value in $_.
my #fields = split ',', $_; # Probably not necessary, depending on how output should be formated.
my $outstring = join ',', $fields(0), $fields(1), $timestamps{$fields(2)}; # And whatever other fields you care for.
print OUTFILE $outstring, "\n"; # Print.
}
close OUTFILE;
print "Done.\n";

perl: why not returning for case 0 or 1?

I am implementing a perl fib with hash table:
#!/usr/bin/perl
use strict;
use warnings;
no warnings 'recursion';
my %m_fib = (0,1,1,1);
while (my $a = <STDIN>) {
print "--".&fib($a)."\n";
}
sub fib {
foreach my $i (#_) {
if (not defined $m_fib{$i}) {
$m_fib{$i} = &fib($i - 1) + &fib($i - 2);
}
return $m_fib{$i};
}
}
It is working well with input larger than 1, but silent with either 0 or 1.
The hash should be fine since it is returning the correct result, but why it won't work if I feed that with 0 or 1?
Your input contains the end of line (\n). Remove it with chomp (documentation)
while (my $a = <STDIN>) {
chomp $a;
print "--".&fib($a)."\n";
}
Edit: What the problem is
with any input the defined test will always fail as the string number\n is not present in the hash
Perl is able to perform a mathematical operation with your input 20\n - 1 is 19
Now with 0 or 1 no defined value is found and your code will call fib(-1) and fib(-2) or fib(0) and fib(-1) respectively. This will generate an endless loop.
With 2 the test will fail and Perl will perform the subtraction calling fib(1) + fib(0) (without the \n). In the second call your test will work as $m_fib(0) does indeed exist.
Edit 2
A small review with a few comments
your function processes more than one argument but exits after the first one. You never call it with more than one argument (and even if you did it will never process the second)
some other comments inline (you can review you code using Perl::Critic)
#!/usr/bin/perl
use strict;
use warnings;
# Not needed
# no warnings 'recursion';
my %m_fib = ( 0, 1, 1, 1 );
# From Perl::Critic
#
# Use "<>" or "<ARGV>" or a prompting module instead of "<STDIN>" at line 10, column 17.
# InputOutput::ProhibitExplicitStdin (Severity: 4)
# Perl has a useful magic filehandle called `*ARGV' that checks the
# command line and if there are any arguments, opens and reads those as
# files. If there are no arguments, `*ARGV' behaves like `*STDIN' instead.
# This behavior is almost always what you want if you want to create a
# program that reads from `STDIN'. This is often written in one of the
# following two equivalent forms:
#
# while (<ARGV>) {
# # ... do something with each input line ...
# }
# # or, equivalently:
# while (<>) {
# # ... do something with each input line ...
# }
#
# If you want to prompt for user input, try special purpose modules like
# IO::Prompt.
while ( my $a = <> ) {
chomp $a;
# use " just when needed
print '--' . fib($a) . "\n";
}
sub fib {
my $i = shift;
if ( not defined $m_fib{$i} ) {
# it is not necessary to use & for subroutine calls and
# can be confused with the logical and
$m_fib{$i} = fib( $i - 1 ) + fib( $i - 2 );
}
return $m_fib{$i};
}

How to remove leading comment whitespace in Perl::Tidy?

I'm just configuring Perl::Tidy to match my preference. I have only one issue left which I can't find a fix.
Sample script:
#!/usr/bin/perl
# | | | | | < "|" indicates first five "tabs" (1 tab 4 spaces).
use strict; # Enable strict programming mode.
use warnings; # Enable Perl warnings.
use utf8; # This is an UTF-8 encoded script.
1;
perltidyrc:
# Perl Best Practices (plus errata) .perltidyrc file
-l=76 # Max line width is 76 cols
-i=4 # Indent level is 4 cols
-ci=4 # Continuation indent is 4 cols
-et=4 # 1 tab represent 4 cols
-st # Output to STDOUT
-se # Errors to STDERR
-vt=2 # Maximal vertical tightness
-cti=0 # No extra indentation for closing brackets
-pt=0 # Medium parenthesis tightness
-bt=1 # Medium brace tightness
-sbt=1 # Medium square bracket tightness
-bbt=1 # Medium block brace tightness
-nsfs # No space before semicolons
-nolq # Don't outdent long quoted strings
-wbb="% + - * / x != == >= <= =~ < > | & **= += *= &= <<= &&= -= /= |= >>= ||= .= %= ^= x="
# Break before all operators
# extras/overrides/deviations from PBP
#--maximum-line-length=100 # be slightly more generous
--warning-output # Show warnings
--maximum-consecutive-blank-lines=2 # default is 1
--nohanging-side-comments # troublesome for commented out code
-isbc # block comments may only be indented if they have some space characters before the #
# for the up-tight folk :)
-pt=2 # High parenthesis tightness
-bt=2 # High brace tightness
-sbt=2 # High square bracket tightness
Result:
#!/usr/bin/perl
# | | | | | < "|" indicates first five "tabs" (1 tab 4 spaces).
use strict; # Enable strict programming mode.
use warnings; # Enable Perl warnings.
use utf8; # This is an UTF-8 encoded script.
1;
As you can see there is a leading space which causes that the "#" doesn't match the forth tab.
How to remove this leading space?
Perltidy is only able to change perl code, as it knows the meaning of perl code. Comments can contain entirely arbitrary data and as such perltidy cannot touch it. So, this kind of thing you'll have to resolve yourself.

How do I print my function using printf?

I have written a function that is a countdown timer.
I want to print this way, Starts in 00:05
Hence I did this, but it doesn't print correctly, it overwrites my sentence. Can you help fix it?
printf("\nStarts in %02d:%02d",countdownsleep(5));
# Sub for countdown
sub countdownsleep {
my $x = shift;
my $t = 1 *$x;
my ($m,$s);
my $stoptime = time + $t;
while((my $now = time) < $stoptime) {
#printf( "%02d:%02d\r", ($stoptime - $now) / 60, ($stoptime - $now) % 60);
$m = ($stoptime - $now) / 60;
$s = ($stoptime - $now) % 60;
select(undef,undef,undef,1);
}
return ($m,$s);
}
The problem is that you are using \r (carriage return) - it returns the carriage to the very start of string (thus overwriting the first 5 characters in the best case scenario); AND causes weird printing behavior in the absence of "\n" (thus possibly not printing anything else after 5 characters).
To fix your problem, you need to do this in your loop inside countdownsleep ():
$prefix = "Starts in "; # could be passed in as parameter to countdownsleep()
printf( "$prefix %02d:%02d\r", ($stoptime - $now) / 60
, ($stoptime - $now) % 60);
# NOTE this ^^^ - now you re-print your prefix every time and not lose due to \r
And in your call:
countdownsleep(5); print "\n"; # printing is done by the loop inside already
# or if you added a $prefix parameter to it:
countdownsleep("Starts in ", 5); print "\n";
Here is why you need to print "\n" at the VERY END
$ perl -e '{print "1234567"; printf("1\r");}'
$ perl -e '{print "1234567"; printf("8\r"); print "\n";}' # Works now
12345678
# And this is what CR really dows
$ perl -e '{print "1234567"; printf("z\r");  printf("yy\r");  print "\n";}'
yy34567z
$ perl -e '{print "1234567"; printf("z\r");  printf("yy\r");  print "zzzz";}'
zzzz
In other words, printing a carriage return (\r) at the end of the string WITHOUT newline (\n) will effectively not print the string at all - more specifically, will erase everything that was suppose to be printed.
Printing (\r) before some other characters in the string will cause the subsequent characters to be printed from the beginning of the line, overwriting existing characters (as many as the new ones), but will keep the subsequent characters intact - with the caveat that the non-overwritten characters won't be printed unless \n is printed at the end.
print "$something\r"; # prints nothing
print "$something\r$finish"; # prints $finish but not $something
# $finish is assumed to not contain "\r"
print "$something\r$finish\n";
# * prints $something (entirely)
# * Moves to start of the line
# * prints $finish overwriting as many characters from $somthing as needed
# * prints the rest of $something if it was longer than $finish
# * prints newline.
On a different note, you should consider using existing coundown/progress CPAN modules instead of rolling your own.
You are "suffering from buffering". Set $|-- at the beginning to turn the buffering off for standard output.