CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Perl Programming Help: Beginner:
How to write dispatch tables ? How to send arguements to the functions

 

First page Previous page 1 2 Next page Last page  View All


Tejas
User

Dec 15, 2014, 9:19 AM

Post #1 of 34 (11682 views)
How to write dispatch tables ? How to send arguements to the functions Can't Post

There are four input files,and i have to create excel worksheets for these files.
Though i have made the code for making it understandable.

Iam using hash to take care of th einputs

Code
use strict; 
use warnings ;

my %input =
(
FILE1 =>
{
path => $ARGV[0],
delim => '|',
headings => [],
},
FILE2 =>
{
path => $ARGV[1],
delim => '|',
headings => [],
},
FILE3 =>
{
path => $ARGV[2],
delim => '|',
headings => [],

} ,
FILE4 =>
{
path => $ARGV[3],
delim => '|',
headings => [],

},

);


Then follows the dispatch functions which point to the specific functionality

Code
my %dispatch_func; 
$dispatch_func{FILE1} = write_to_file1();
$dispatch_func{FILE2} = write_to_file2();
$dispatch_func{FILE3} = write_to_file3();
$dispatch_func{FILE4} = write_to_file4();



Now, Iam opening the files one by one and then writ it to excel sheet,
The excel code has been chopped off and a direct print statement is added by me for making the code easily readable.


Code
while ( my ( $worksheet_id, $worksheet_info ) = each ( %input ) )  
{
my $path = $worksheet_info->{path};
my $delim = $worksheet_info->{delim};
my $headings = $worksheet_info->{headings};
open my $handle, '<', $path or die "could not open '$path': $!";
while ( my $line = <$handle> )
{
chomp $line;
my $myid = 1 ;
my @data = split /\Q$delim\E/, $line;
$dispatch_func{$worksheet_id}->(\@data,$myid);
}
}


I would wish to send these 2 variables(there are aroun 4 parameters though ) using the dispatch hash to its specific function
and im facing issue with this.


Code
write_to_file1 
{

for my $col ( 0 .. $#data )
{
print "$data[$col] \t";
}
print "\n";
}

write_to_file2
{

for my $col ( 0 .. $#data )
{
print "$data[$col] \t";
}
print "\n";
}


The data in these fucntions is empty and no data is being sent, the parameters that are being sent are nt really available in functions.

Probably there should be another subroutne in these fnctions to handle parameters, but i dint get any results.

How to send and recive the parameters in these dispatch function excatly ?


Thanks
Tejas


Zhris
Enthusiast

Dec 15, 2014, 9:43 AM

Post #2 of 34 (11676 views)
Re: [Tejas] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Hi,

Make sure you reference each write function when constructing the dispatch func hash, you are currenly calling each write function instead, which will likely have returned an undef value:


Code
my %dispatch_func;  
$dispatch_func{FILE1} = \&write_to_file1;
$dispatch_func{FILE2} = \&write_to_file2;
$dispatch_func{FILE3} = \&write_to_file3;
$dispatch_func{FILE4} = \&write_to_file4;


Better yet, extend the input hash instead:


Code
FILE1 =>   
{
path => $ARGV[0],
delim => '|',
headings => [],
dispatch_func => \&write_to_file1,
},

...

my $dispatch_func = $worksheet_info->{dispatch_func};
$dispatch_func->( \@data, $myid );


And finally, make sure you declare subroutines using sub and that you use or assign the arguments from @_ appropriately:


Code
sub write_to_file1  
{
my ( $data, $myid ) = @_;

for my $col ( 0 .. $#{$data} )

...


Regards,

Chris


(This post was edited by Zhris on Dec 15, 2014, 9:52 AM)


FishMonger
Veteran / Moderator

Dec 15, 2014, 10:07 AM

Post #3 of 34 (11666 views)
Re: [Tejas] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

It would be more helpful if you post a short but complete script that demonstrates the problem. Fortunately, there was enough info in your code fragments to see the 1st major problem, which was your %dispatch_func assignments. Chris already addressed that issue.

Based on your snippets, I'd say that there are code duplication issues that should be addressed. In what way do those 4 write_to_file functions differ? Based on what you've posted, they only differ in which file they print to. If that's the case, then those subs should be combined into 1 sub and pass the filename (or more preferably the file handle) to it.

There are other things I could point out, but I'm running late for an appointment.


Tejas
User

Dec 15, 2014, 10:11 AM

Post #4 of 34 (11662 views)
Re: [Zhris] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Thanks Chris.
I am trying to implement both the approaches and i feel that the approach u have suggested is good.


Thanks


Laurent_R
Veteran / Moderator

Dec 15, 2014, 10:15 AM

Post #5 of 34 (11661 views)
Re: [Tejas] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Chris has given you a perfect solution to yours problems.

I would just mention that you can also build directly your code refs:


Code
my $write_to_file_1_ref = sub { 
my $param1 = shift;
my @data = @_;
#...
}

Then you can put $write_to_file_1_ref (a code ref) into your hash and use it tjust the sam way.


Tejas
User

Dec 15, 2014, 10:19 AM

Post #6 of 34 (11659 views)
Re: [FishMonger] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

The onbly reason i needed these funcs beacuse.

Each value im printing in excel sheet are of different formats

ex : values at index 0 to 3 can be numbers,others are dates, some are strings
And these indexes are not unique in all the files..

A Simple Code Snippet , for File 1

Code
if($worksheet_id eq 'FILE1' ) 
for my $col ( 0 .. $#data )
{
if( $col == 1 || $col == 12){
$worksheet->write_string( $row, $col, $data[$col]); }
elsif($col == 2 || $col == 3 || $col == 11){
$worksheet->write_string( $row, $col, $data[$col],$date_format);}
else {$worksheet->write_number( $row, $col, $data[$col]); }

}
if($worksheet_id eq 'FILE2' )
{
for my $col ( 0 .. $#data )
{
if($col == 0 || $col == 1 || $col == 3 ){
$worksheet->write_string( $row, $col, $data[$col]);}
elsif($col == 5) { $worksheet->write_string( $row, $col, $data[$col],$date_format);}
else {$worksheet->write_number( $row, $col, $data[$col]); }
}

}


For the same reason i needed seperate functions

Thanks
Tejas


Zhris
Enthusiast

Dec 15, 2014, 10:21 AM

Post #7 of 34 (11656 views)
Re: [Tejas] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post


Quote
The excel code has been chopped off and a direct print statement is added by me for making the code easily readable.


If there are strong similarities between the individual functions in your production code that writes to excel, make sure you follow Fishmonger's advise and reduce into a single function.

Chris


(This post was edited by Zhris on Dec 15, 2014, 10:23 AM)


Tejas
User

Dec 15, 2014, 10:26 AM

Post #8 of 34 (11653 views)
Re: [Zhris] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

I pasted the excel code above,
And just beacuse of the format of the columns , i have ot crete a seperate funtions to handle them .

Or else if its a same func ..i again have to check thoe worksheet_id and write if conditions

Thanks
Tejas


Zhris
Enthusiast

Dec 15, 2014, 10:42 AM

Post #9 of 34 (11648 views)
Re: [Tejas] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Hi,

One approach could be to supply the col numbers of your string and date cols in your input hash. You can pass these col numbers when you call the dispatch function.


Code
FILE1 =>    
{
path => $ARGV[0],
delim => '|',
headings => [],
cols => { string => [ 1, 12 ], date => [ 2, 3, 11 ] },
},



Code
use List::Util qw/ any /; 

...

write_to_file( ..., $worksheet_info->{cols} );

...

sub write_to_file
{
my ( $data, ..., $cols ) = @_;

for my $col ( 0 .. $#{$data} )
{
if ( any { $col == $_ } @{$cols->{string}} )
{
$worksheet->write_string( $row, $col, $data[$col] );
}
elsif( any { $col == $_ } @{$cols->{date}} )
{
$worksheet->write_string( $row, $col, $data[$col], $date_format );
}
else
{
$worksheet->write_number( $row, $col, $data[$col] );
}
}
}


Regards,

Chris


(This post was edited by Zhris on Dec 15, 2014, 10:43 AM)


Tejas
User

Dec 15, 2014, 10:48 AM

Post #10 of 34 (11645 views)
Re: [Zhris] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Great.
This seems to be easily maintable too.
Thanks Chris, for ur fast replies.

U ve not only solved the main issue, but have given me an easy design.
will reimplement this and come back




Thanks
Tejas


Laurent_R
Veteran / Moderator

Dec 16, 2014, 9:59 AM

Post #11 of 34 (11609 views)
Re: [Tejas] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Yes, by all means, this is a better solution.

The other way would be to build a "function factory": a function which returns code refs to custom print functions. This tends to reduce considerably the coding work when you have to write to a relatively large number of different files.


Tejas
User

Dec 16, 2014, 10:16 AM

Post #12 of 34 (11603 views)
Re: [Laurent_R] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

What's a function factory
Can u please explain
And if possible pleas provide a code snippet

I have implemented Chris's solution and it's really working great
Will update the post , and we can end this post.

Thanks
Tejas


Laurent_R
Veteran / Moderator

Dec 16, 2014, 11:51 PM

Post #13 of 34 (11471 views)
Re: [Tejas] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

An example of function factory. Suppose you want to store in 26 different files words of an input file in accordance with the first letter of these words. You could do something like this (I know it works in principle, but the code below is untested, I can't test right now).


Code
my %dispatch_table; 
for (a..z) {
$dispatch_table{$_} = create_func($_);
}

sub create_func {
my $letter = shift;
my $file = "letter_$letter.txt";
open my $FH, ">", $file or die "can't open $file $file $!";
return sub { my $output = shift; print $FH $output;}
}


This opens 26 files and creates 26 different function references stored in a dispatch table. Each function knows about its own fila handle and knows where to write.

Then, when reading the input, all you need to do is to to pick up the first letter of each word and to call the function reference for that letter in the dispatch table. Something like this:


Code
for my $word (@words) { 
my $start_letter = $word =~ /^./;
$dispatch_table{$start_letter}->($word);
}



(This post was edited by Laurent_R on Dec 16, 2014, 11:53 PM)


Tejas
User

Dec 17, 2014, 10:32 AM

Post #14 of 34 (11428 views)
Re: [Laurent_R] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Thanks Laurent

This snippet would really be helpful for me in my future assignments

Code
my %dispatch_table;  
for (a..z) {
$dispatch_table{$_} = create_func($_);
}
sub create_func {
my $letter = shift;
my $file = "letter_$letter.txt";
open my $FH, ">", $file or die "can't open $file $file $!";
return sub { my $output = shift; print $FH $output;}
}


I see that we are sending a single arguement and that is the letter
But where is thsi getting input from

Code
return sub { my $output = shift; print $FH $output;}

shift actaully gets the first variable from input..which we already have saved in $letter,
what does $output contain


Quote
I have one more issue or rather doubt regadring the implementation, this actually is chris's idea that i implemented
I have a hash of formulaes, that are related to excel sheet and i print these in cells.


Code
my $ptech_formulas = 
{

0 => sub { my $row = shift; $row = $row+1 ;qq/=IF(B${row}="", "", TEXT(WEEKDAY(B${row}), "ddd"))/ },
1 => sub { my $row = shift; qq/=IF(B${row}="", "", IF(B${row}+1>EOMONTH(B${row}, 0), "", B${row}+1))/},
2=> sub { my $row = shift;$row = $row+1 ;qq/=IFERROR(SUMIFS(SLA!\$J:\$J,SLA!\$N:\$N,\$C\$4,SLA!\$E:\$E,65100,SLA!\$M:\$M,Summary!B${row}),0)+IFERROR(SUMIFS(SLA!\$J:\$J,SLA!\$O:\$O,\$C\$4,SLA!\$E:\$E,65100,SLA!\$M:\$M,Summary!B${row}),0)/},
3 => sub { my $row = shift; $row = $row+1 ;qq/=IFERROR(SUMIFS(SLA!\$J:\$J,SLA!\$N:\$N,\$C\$4,SLA!\$E:\$E,65910,SLA!\$M:\$M,Summary!B${row}),0)+IFERROR(SUMIFS(SLA!\$J:\$J,SLA!\$O:\$O,\$C\$4,SLA!\$E:\$E,65910,SLA!\$M:\$M,Summary!B${row}),0)/} ,
4 => sub { my $row = shift; $row = $row ;qq/=B${row}/},
5 => sub { my $row = shift; $row = $row+1 ;qq/= -SUMIFS('PTI FIN25'!L:L, 'PTI FIN25'!F:F,E${row}, 'PTI FIN25'!E:E, \$C\$5)-SUMIFS('PTI FIN25'!M:M, 'PTI FIN25'!F:F,E${row}, 'PTI FIN25'!E:E, \$C\$5)/},
6 => sub { my $row = shift; $row = $row+1 ;qq/=-SUMIFS('PTI FIN25'!K:K, 'PTI FIN25'!F:F,E${row},'PTI FIN25'!E:E, \$C\$5)/ },
7 => sub { my $row = shift; $row = $row+1 ;qq/=IFERROR((D${row}+C${row})-SUM(F${row}:G${row}),0)/},
8 => sub { my $row = shift; $row = $row+1; qq/=IF(C${row}=0,"Current Month in transit","")/ } ,
default => { sub{ qq/=EOMONTH(B2,-1)+1/ },
default1 => sub{my $row = shift; $row = $row+2 ; qq/=E${row}-1/ },
};



Quote
And i call them like


Code
my $days_in_month = 30; 
my $summary_row = 1;
my $offset = 2 ;
$days_in_month = $days_in_month +$offfset ;
my $transit_day = $days_in_month-$offfset;
for my $day_rows (1..$days_in_month){
for my $cols(0..$#{$headings}){
if($cols == 1 && $day_rows == 1){
printf $formulas->{default}->($summary_row);
}
elsif($cols == 4 && $day_rows == 1){
printf $formulas->{default1}->($summary_row) ;
}
else {
if ( exists $formulas->{$cols} ){
if ($cols == 1 || $cols == 4){
printf $formulas->{$cols}->($summary_row);
}
else {
if($cols != 8 ) {
printf $formulas->{$cols}->($summary_row);
}
elsif ($cols == 8 && $day_rows >= $transit_day ){
printf $formulas->{$cols}->($summary_row) ;
}
}
}
else {
}
}

}
$summary_row++;
}



Firstly , im calling the default columns for row 1
and then im continuing with the normal columns which is sime.
I owuld want this hard coding stuff to be simplified by using
a hash of rownum and col num which has its value as the functions

Ex
in my formula hash
i have
default => (we have formula here)

i would want to have

default=>rownum=>colnum=>{sub ...}

so that i can call all the defualt with the corresponding row num and coil num an dthen go ahead printing the normal column formulas


Quote
Explaination of if conditions

if($cols == 1 && $day_rows == 1) # for row one and column 1 we have default formula
elsif($cols == 4 && $day_rows == 1) # for row one and column 4 we have default1 formula

if ( exists $formulas->{$cols} ) #After printing default , print all the columns with formulas correspoding to col number

At the end iam printing a summary column 8 for some offset dates (i.e from last day -2 in this code )

Code
if($cols != 8 ) { 
printf $formulas->{$cols}->($summary_row);
}
elsif ($cols == 8 && $day_rows >= $transit_day ){
printf $formulas->{$cols}->($summary_row) ;
}


Thanks
Teja

(This post was edited by Tejas on Dec 17, 2014, 10:38 AM)


Zhris
Enthusiast

Dec 17, 2014, 12:46 PM

Post #15 of 34 (11412 views)
Re: [Tejas] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Hi,

With regards to your first question, you are creating and returning subroutine references ( AKA anonymous subroutines, closures ). You can find useful information here. They are not run until you explicitly dereference / call them, at which point the arguments you supply are copied to @_. Try to follow the basic example below and you'll see the outer and inner subroutines work independently:


Code
my $innerref = outer( 'outerarg' ); 
$innerref->( 'innerarg' );

sub outer
{
my $arg = shift;

print "in outer - $arg\n";

return sub
{
my $arg = shift;

print "in inner - $arg\n";

return;
};
}


With regards to your second question, firstly I did suggest something similar over Skype but you haven't quite understood the purpose of my suggestion. The idea was that because you had alot of formulas across your code, many of which were very similiarly notated, I thought it would be better to group them in a hash using distinguishable keys and subroutine values, which you could call directly i.e. $formulas->{total_the_col}->( $col ). I didn't intend the hash to have col numbers as keys nor used quite in the manner you have in certain instances, although its not a problem if it works well for you.

I later suggested that you create an array of arrays that represents sections of your worksheet, which you can populate with information on how to fetch the value / which print method to use ( or even combination of both ). Roughly, here is the implementation I suggested, I'm sure there is probably a better way to do it, I will certainly get back to you if I think of one, I'll try to take another look when I have time:


Code
use strict;  
use warnings;

my $days_in_month = 10;
my @headings = ( 'A' .. 'Z' );

my $fetch =
{
default => sub { '--' },
headings => sub { my $heading = splice @headings, 0, 1; "$heading " }, # or $headings[$_[1]] etc.
custom1 => sub { 'c1' },
custom2 => sub { 'c2' },
};

my $print =
{
default => sub { print $_[0] },
custom1 => sub { print $_[0] },
custom2 => sub { print $_[0] },
};

my $grid = [ ];
prepop( $grid, [ 0 ], [ 0 .. 9 ], [ $fetch->{headings}, $print->{default} ] ); # 1st row, cols 1 to 10.
$grid->[1]->[0] = [ $fetch->{custom1}, $print->{custom1} ]; # 2nd row, 1st col.
$grid->[$days_in_month - 1]->[1] = [ $fetch->{custom2}, $print->{custom2} ]; # last row, 2nd col.
prepop( $grid, [ 1 .. 5 ], [ 4, 8 ], [ $fetch->{custom1}, $print->{custom2} ] ); # rows 2 to 6, cols 5 and 9.

for my $row ( 0 .. $days_in_month - 1 )
{
for my $col ( 0 .. 9 )
{
if ( my $subrefs = $grid->[$row]->[$col] )
{
# use custom fetch and print subrefs.
$subrefs->[1]->( $subrefs->[0]->( $row, $col ) );
}
else
{
# use default fetch and print subrefs.
$print->{default}->( $fetch->{default}->( $row, $col ) );
}

print '|';
}

print "\n";
}

sub prepop
{
my ( $list, $rows, $cols, $val ) = @_;

map { @$_[@$cols] = ( $val ) x @$cols } @$list[@$rows]; # complex one liner instead of two for loops.

return 1;
}


Regards,

Chris


(This post was edited by Zhris on Dec 17, 2014, 3:10 PM)


Laurent_R
Veteran / Moderator

Dec 17, 2014, 3:33 PM

Post #16 of 34 (11365 views)
Re: [Tejas] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Hi Tejas,

I will answer only to the part of your post where you were answering to me. Chris has explained fairly well the point, but I wish to go further into details.


In Reply To

Code
my %dispatch_table;  
for (a..z) {
$dispatch_table{$_} = create_func($_);
}
sub create_func {
my $letter = shift;
my $file = "letter_$letter.txt";
open my $FH, ">", $file or die "can't open $file $file $!";
return sub { my $output = shift; print $FH $output;}
}


I see that we are sending a single arguement and that is the letter
But where is thsi getting input from

Code
return sub { my $output = shift; print $FH $output;}

shift actaully gets the first variable from input..which we already have saved in $letter,
what does $output contain


What is happening here is that, for each letter of the alphabet, I am calling create_func, passing it each such letter. The create_func function gets the letter, opens up one file, and returns to the caller the

Code
sub { my $output = shift; print $FH $output;}

code ref without executing it. What is returned is a coderef (or function ref), and this coderef is stored into the dispatch table hash for the current letter.

At the end of this process the dispatch table contains 26 slots, the keys being the 26 letters of the alphabet and the values 26 different code references for printing to 26 different private file handles.

But the code in

Code
sub { my $output = shift; print $FH $output;}

still has not been executed even once. It is just ready to be used.

Then, the second step is to read a word list and dispatch the words into the 26 different files. This is what is going on in the next code snippet:


Code
for my $word (@words) {  
my $start_letter = $word =~ /^./;
$dispatch_table{$start_letter}->($word);
}

The above code reads a word list, and, for each word, figures out what the first letter of that word is. It looks into the dispatch table hash for that start letter, and calls the code reference stored for that letter in the dispatch table, passing it as an argument the word being examined. It is at this point only that the code ref

Code
sub { my $output = shift; print $FH $output;}

is being executed. So the "shift" builtin operator grabs the word passed as an argument and stored it into the $output variable, which is then printed out to the right file.

I wrote my earlier message on that on a mobile device while commuting to go to work, so I had no way to test it out. I can see at least one small error. The code for building the printing code ref should be more something like this:

Code
sub { my $output = shift; print $FH $output, "\n";}

in order to separate the words by a newline sequence.

This is now a fully working example:

Code
use strict; 
use warnings;

my %dispatch;
$dispatch{$_} = create_sub($_) for ('a'..'z');
while (<>) {
$dispatch{$1}->($_) if (/^([a-z])/) ;
}

sub create_sub {
my $letter = shift;
my $file_name = "letter_$letter.txt";
open my $FH, ">", $file_name or die "unable to open $file_name $!";
return sub { my $line = shift; print $FH $line; }
}

The point I want to make is that this makes it possible to create 26 different files and to dispatch words in all these files within less than 10 lines of executable code. This technique is admittedly slightly advanced programming, but it reduces coding effort considerably. How many lines of code would you have thought it would take to dispatch words from an input file between 26 different files before you read the above?

I passed to this script a file containing the full text of the Bible (both Old and New Testament, in a, old French edition available on the Internet), which I had previously (for another project) modified to remove diacritic signs (accents, cedillas, etc.) and punctuation signs, and to lower case the full text, so that my file was really a list of Bible's words (lower case) in the said edition (a file of about 4.2 MB).

The program created the 26 letter_a.txt, letter_b.txt, etc. files. Five of them remained empty (no word starting with letters k, y, x, w and z was found in that edition of the Bible). The others have between 155 bytes (letter H) and 96064 bytes (letter E). This is not a surprise, as the letter E is by far the most common letter in the French language.

Just in case you worry about performance, I timed the execution of the program on the full Bible file, and the program ran in just slightly less than 0.1 second on my laptop computer (a rather good and rerlatively recent computer, but not a racing horse either).

As I said, this is a relatively advanced technique, don't worry if you don't really understand it right now. Over the months, I have seen you progressing from early beginner to a more advanced level, but this might still be a bit complicated for you. Also, it is a slightly peculiar programming technique, which you might call "functional programing in Perl". If you find these techniques a bit too complicated for you at this point, don't worry, you might come back to it in a few months from now. On the other hand, if you want to know more about these techniques, I would advise you to read Mark-Jason Dominus' excellent book, "Higher Order Perl", which can be found easily (and legally) in PDF format on the Internet. (I originally read that book in PDF format on the Internet, but found it so great that I quickly ended up buying a paper copy).


Zhris
Enthusiast

Dec 17, 2014, 4:06 PM

Post #17 of 34 (11361 views)
Re: [Laurent_R] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Excellent description Laurent.

I'm wondering how something like the following would compare, instead of storing a coderef, the filehandle is stored directly. Inevitably your codes purpose is to demonstrate a point and using the coderef technique is without doubt paramount in complex cases where coderef internals or supplied arguments must greatly vary between. Note, I would personally choose the coderef technique, it is very elegant and confines file processing code together.


Code
use strict;  
use warnings;

my %dispatch;
$dispatch{$_} = create_fh($_) for ('a'..'z');
while (<>) {
do { my $FH = $dispatch{$1}; print $FH $_ } if (/^([a-z])/);
}

sub create_fh {
my $letter = shift;
my $file_name = "letter_$letter.txt";
open my $FH, ">", $file_name or die "unable to open $file_name $!";
return $FH;
}


Chris


(This post was edited by Zhris on Dec 17, 2014, 4:23 PM)


Tejas
User

Dec 17, 2014, 6:12 PM

Post #18 of 34 (11343 views)
Re: [Laurent_R] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Thanks Laurent
Now I understand that it's just a coderef tht is being saved and the parameter is taken when I call that very function.
I would want to give credit to Chris
Who has been a great help for me all through my problems and has given me a lot of easy coding techniques.
And also suggestions by you , Bill and fishmonger also has been really great
Though I do not still belev that I can go ahead and write a crisp perl code without your help.


Thanks
Tejas


Laurent_R
Veteran / Moderator

Dec 18, 2014, 12:02 AM

Post #19 of 34 (11319 views)
Re: [Zhris] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Hi Chris,

surely, storing the file handle into the hash is a good alternative (which I actually used at my work just a couple of days ago), also leads to fairly concise code, and it is probably a bit easier to understand for a beginner. I would simplify it slightly in this way:

Code
use strict;   
use warnings;

my %dispatch;
$dispatch{$_} = create_fh($_) for ('a'..'z');
while (<>) {
print {$dispatch{$1}} if (/^([a-z])/);
}

sub create_fh {
my $letter = shift;
my $file_name = "letter_$letter.txt";
open my $FH, ">", $file_name or die "unable to open $file_name $!";
return $FH;
}

I still very much like the idea of using anonymous closures. In more complicated cases, it enables me to separate more clearly the business requirements (removing duplicates, making joints with data in another hash, etc.) from the logic to print out the data to the output files, which can itself be more complicated (I have requirements such as output files should not be larger than 20,000 lines, so that I have to create multiple output files with sometimes complicated file naming convention). Separating the pure business logic from the technical part of printing to files makes my work often quite easier, especially when dealing with exceptions or edge cases.


Zhris
Enthusiast

Dec 18, 2014, 11:24 AM

Post #20 of 34 (11296 views)
Re: [Laurent_R] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

The syntax {$dispatch{$1}} is new to me, when I first looked at it, it looked like a hash ref was being created from the return value of $dispatch{$1}. Could you please explain what the curly braces do, is it at all related to the ${var} syntax, and is there documentation available on this technique? I surprisingly received a syntax error upon print $dispatch{$1} $_, which was why I took the do approach, as you stated, yours is a much simpler form that I would like to understand ( perhaps it has uses under other circumstances where I could have used it ).

Thanks,

Chris


(This post was edited by Zhris on Dec 18, 2014, 11:31 AM)


FishMonger
Veteran / Moderator

Dec 18, 2014, 12:03 PM

Post #21 of 34 (11287 views)
Re: [Zhris] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

The syntax print {$dispatch{$1}} is documented in perldoc -f print.


Code
    print FILEHANDLE LIST 
print FILEHANDLE
print LIST
....
....
....
If you're storing handles in an array or hash, or in general
whenever you're using any expression more complex than a
bareword handle or a plain, unsubscripted scalar variable to
retrieve it, you will have to use a block returning the
filehandle value instead, in which case the LIST may not be
omitted:

print { $files[$i] } "stuff\n";
print { $OK ? STDOUT : STDERR } "stuff\n";



(This post was edited by FishMonger on Dec 18, 2014, 12:05 PM)


Zhris
Enthusiast

Dec 18, 2014, 12:40 PM

Post #22 of 34 (11279 views)
Re: [FishMonger] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Thank you very much.

Chris


Laurent_R
Veteran / Moderator

Dec 18, 2014, 3:26 PM

Post #23 of 34 (11262 views)
Re: [FishMonger] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Thank you, FishMonger, for answering Chris' question with all the details. It is almost half past midnight here, I would certainly have given a general answer if you had not, but I am not sure I would have taken the time to find the detailed documentation you provided.


Tejas
User

Dec 20, 2014, 10:37 AM

Post #24 of 34 (11106 views)
Re: [Laurent_R] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Hi
Please have a look at th ebelow code, Also please look at the comments in th code snipoet.
There are set of formulas in a hash, which i am trying to set in an excel cell.And i just have a print statement in the code, for easy understanding

Code
use strict ; 
use warnings;

my $mex_formulas =
{
0 => sub { my $row = shift; $row = $row+1 ;qq/=IF(B${row}="", "", TEXT(WEEKDAY(B${row}), "ddd"))/ },
1 => sub { my $row = shift; qq/=IF(B${row}="", "", IF(B${row}+1>EOMONTH(B${row}, 0), "", B${row}+1))/},
2=> sub { my $row = shift;$row = $row+1 ;qq/=IFERROR(SUMIFS(USL!\$J:\$J,USL!\$N:\$N,\$C\$6,USL!\$E:\$E,65100,USL!\$M:\$M,Summary!B${row}),0)+IFERROR(SUMIFS(USL!\$J:\$J,USL!\$O:\$O,\$C\$6,USL!\$E:\$E,65100,USL!\$M:\$M,Summary!B${row}),0)/},
3 => sub { my $row = shift; $row = $row+1 ;qq/=IFERROR(SUMIFS(USL!\$J:\$J,USL!\$N:\$N,\$C\$6,USL!\$E:\$E,65910,USL!\$M:\$M,Summary!B${row}),0)+IFERROR(SUMIFS(USL!\$J:\$J,USL!\$O:\$O,\$C\$6,USL!\$E:\$E,65910,USL!\$M:\$M,Summary!B${row}),0)/} ,
4 => sub { my $row = shift; $row = $row ;qq/=E${row}+1/},
}

my $custom_formulas= {
custom1 => sub { qq/=EOMONTH(B2,-1)+1/ },
custom2 => sub { my ($row,$offset) = @; $row = $row+1 ;qq/=B${row}-$offset/ },
custom7 => sub { my $row = shift; $row = $row+1 ;qq/=IFERROR((C${row}-F${row})-L${row},0)/},
custom9 => sub { my $row = shift; $row = $row+1 ;qq/=IFERROR((D${row}-G${row})-M${row},0)/},
};

my $print =
{
custom1 => sub { print " $_[2], $date_format |" },
custom2 => sub { print " $_[2]|" }, # how are we sending arguements to custom_formulaes
custom7 => sub { print " $_[2]|" },
custom9 => sub { print " $_[2]|" },
};


As per Chris's code, i am also trying to maintain a grid , rather than having set of nasty if conditions in the code.

Below is the grid

Code
my $array = 
[
[
1,
2,
3,
],
[
4,
[$custom_formulas->{custom1}, $print->{custom1} ],
undef,
undef,
[$custom_formulas->{custom2}, $print->{custom2} ],
undef,
undef,
[$custom_formulas->{custom7}, $print->{custom7} ],
undef,
[$custom_formulas->{custom9}, $print->{custom9} ],
],
[
undef,
],
];


All this grid does it to call the corresponding formulaes
for 1st row and 2nd,3rd,7th and 9th columns

Below is the func which calls the grid

Code
my_func($mex_formulas,3); 

sub my_func {

my ($fetch,$offset) = @_ ; #how to send this offest to custom formula 2 , also i dint really get how row numbers are being passed by $print to $customer_formnulas and we have to send the row number to formulate .
my $no_of_days = 30;
my $no_of_cols = 10;
for my $row ( 0 .. $no_of_days )
{

for my $col ( 0 .. $no_of_cols)
{
my $val = $array->[$row]->[$col];

if ( defined $val )
{
if ( ref $val eq ref [ ] )
{

$val->[1]->( $row, $col, $val->[0]->( ) ); #offset has to be sent to the custom2 formula #TODO a
}
else
{
print $fetch->{$col}->($row), "|" ; #This is throwing error
}
}
else
{
print $fetch->{$col}->($row) , "|"; #This is throwing error
}
}
print "\n";
}

}


All it does is to call the custom formulas in special cases i.e if that row and col are defined in $array or jsut call the main formula hash($mex_formulas)
Im just unable to send the arguements to any of those formulaes.

Custom_formulas get data from $print , and im really confused how to send it to $print and how does $print send the paramentrs to $custom_formula

Just for an idea , below is the code that i have currently wth nasty if conditions.but $array (lets call it grid) seems to be a beeter option like chris mentioned

Nasty If's

Code
my $initial_row = $summary_row+1; 
my $varience_row = $days_in_month + $initial_row;
for my $day_rows (1..$days_in_month){
for my $cols(0..$#{$headings}){
if($cols == 1 && $day_rows == 1){
$summary_worksheet-> write_formula($summary_row, $cols,$formulas->{default}->($summary_row),$date_format);
}
elsif($cols == 4 && $day_rows == 1){
$summary_worksheet-> write_formula( $summary_row, $cols,$formulas->{default1}->($summary_row),$date_format);
}
elsif($cols == 7 && $day_rows == 1){
$summary_worksheet-> write_formula( $summary_row, $cols,$formulas->{default2}->($summary_row) ) ;
}
elsif($cols == 9 && $day_rows == 1){
$summary_worksheet-> write_formula( $summary_row, $cols,$formulas->{default3}->($summary_row) ) ;
}
else {
if ( exists $formulas->{$cols} ){
if ($cols == 1 || $cols == 4){
$summary_worksheet-> write_formula( $summary_row, $cols,$formulas->{$cols}->($summary_row),$date_format);
}
else {
if( $cols != 8 && $cols != 10 ) {
print "Column Number = $cols \n";
$summary_worksheet-> write_formula( $summary_row, $cols,$formulas->{$cols}->($summary_row));
}
elsif ($cols == 8 || $cols == 10){
print " Varience_row = $cols in call\n";
$summary_worksheet-> write_formula( $summary_row, $cols,$formulas->{$cols}->($summary_row,$varience_row),$headings_format);
}

}
}
else {


}
}

}
$summary_row++;
$formula_row++;
}


So Rather than these if 's we have a grid which solves the problem ,
But iam not sure how to send parameters and also

$fetch->{$col}->($row) is throwing error

Thanks
Tejas


Zhris
Enthusiast

Dec 20, 2014, 4:38 PM

Post #25 of 34 (11089 views)
Re: [Tejas] How to write dispatch tables ? How to send arguements to the functions [In reply to] Can't Post

Hi,

Firstly, the code I provided was my initial attempt at one way I might approach this task as I understand it. I'm interested if others feel it is a feasible approach and if not how they might approach it more simply. I don't want you to necessarily feel this is the only and right way to accomplish it, I just want to help you make it more manageable.

I see you are having difficulties in understanding the code I provided and how to modify it to support your requirements. That is not a problem, as Laurent mentioned above, we are covering some advanced aspects of Perl. Eventually, I would like to help you turn this into a set of object orientated packages, which would be most suitable, but is dwelving much deeper than necessary for now.

I don't want to modify the code for you, using your working nested conditions version, because if you don't understand how the code works now at its most basic level, you will be unable to extend it correctly to support your real world data in future.

There are just two places you should need to extend from. Do not touch any other parts of the code except perhaps adding some more declarations.
- Firstly you will need to populate the fetches and prints hashrefs appropriately. In fact these don't even have to be hashrefs, or they can be as many levels deep as you want. Their purpose is simply to organize your fetch and print coderefs in whatever manner you wish.
- Secondly you will need to build the grid appropriately from the above hashrefs i.e. modify the code in the build_grid function just underneath the "populate the grid" comment. As you can see, we are hardcoding / reading directly from the fetch and print hashrefs here, therefore as mentioned above, you are not restricted to a particular fetch and print ref design.

Below I have provided a new version of my code. I have also used this opportunity to test my Perl Guru markup tool I wrote a few months ago (a project in progress), which should aid in reading the code.

A key change made is that functions and function references now support hash based arguments. This is more appropriate because it is much easier to add or remove arguments in any order without having to adjustments in multiple places. I have also commented throughout.

If possible, try to understand what is happening, play around with it, modify it, test it. If there is anything in particular you don't understand, please explain those specific misunderstandings. I realise you have already asked a few questions, but I would prefer to wait until you have had another chance to look it over before answering.

Goodluck,

Chris


Code
1.	use strict; 
2. use warnings FATAL => qw/all/;
3.
4. ##################################################
5. #
6. # declarations.
7. #
8.
9. my $worksheet = undef; # to prevent error for now.
10.
11. my $fetches =
12. {
13. default => sub { '' }, # default should return blank to assume empty cell.
14. dump => sub { "@_" },
15. row_i_col_i => sub { my $params = { @_ }; "$params->{row_i}, $params->{col_i}" },
16. };
17.
18. my $prints_stdout =
19. {
20. default => sub { my $params = { @_ }; print $params->{val} },
21. string => sub { my $params = { @_ }; print $params->{val} },
22. };
23.
24. my $prints_excel =
25. {
26. default => sub { my $params = { @_ }; $worksheet->write_string( $params->{row_i}, $params->{col_i}, $params->{val} ) },
27. string => sub { my $params = { @_ }; $worksheet->write_string( $params->{row_i}, $params->{col_i}, $params->{val} ) },
28. };
29.
30. ##################################################
31. #
32. # main.
33. #
34.
35. print "begin\n\n";
36.
37. my $grid = build_grid
38. (
39. fetches => $fetches,
40. prints => $prints_stdout,
41. );
42.
43. print_worksheet
44. (
45. max_row_i => 30,
46. max_col_i => 10,
47. grid => $grid,
48. default_fetch => $fetches->{default},
49. default_print => $prints_stdout->{default}, # use $prints_excel when printing to excel.
50. row_separator => "\n", # likely want to undefine this when printing to excel.
51. col_separator => ' | ', # likely want to undefine this when printing to excel.
52. );
53.
54. print "\n\nend";
55.
56. ##################################################
57. #
58. # functions.
59. #
60.
61. # builds the grid arrayref.
62. sub build_grid
63. {
64. # convert @_ into a hashref.
65. my $params = { @_ };
66.
67. # assign default values to params.
68. # note //= notation is not recognized earlier versions of Perl.
69. $params->{fetches} = { } unless defined $params->{fetches};
70. $params->{prints} = { } unless defined $params->{prints};
71.
72. # define grid as an array reference.
73. my $grid = [ ];
74.
75. # populate the grid with data, commonly using the design grid->[row_i]->[col_i] = [fetch, print].
76. $grid->[1]->[0] = [ $params->{fetches}->{row_i_col_i}, $params->{prints}->{string} ];
77. $grid->[1]->[3] = [ $params->{fetches}->{row_i_col_i}, $params->{prints}->{string} ];
78. $grid->[1]->[6] = [ $params->{fetches}->{row_i_col_i}, $params->{prints}->{string} ];
79. $grid->[1]->[8] = [ $params->{fetches}->{row_i_col_i}, $params->{prints}->{string} ];
80.
81. return $grid;
82. }
83.
84. # prints the worksheet.
85. sub print_worksheet
86. {
87. # convert @_ into a hashref.
88. my $params = { @_ };
89.
90. # assign default values to params.
91. # note //= notation is not recognized in earlier versions of Perl.
92. $params->{max_row_i} = 0 unless defined $params->{max_row_i};
93. $params->{max_col_i} = 0 unless defined $params->{max_col_i};
94. $params->{grid} = [ ] unless defined $params->{grid};
95. $params->{default_fetch} = sub { '' } unless defined $params->{default_fetch};
96. $params->{default_print} = sub { print "@_" } unless defined $params->{default_print};
97. $params->{row_separator} = undef unless defined $params->{row_separator}; # pointless but here for completeness.
98. $params->{col_separator} = undef unless defined $params->{col_separator}; # pointless but here for completeness.
99.
100. # loop through rows / cols.
101. for my $row_i ( 0 .. $params->{max_row_i} )
102. {
103. for my $col_i ( 0 .. $params->{max_col_i} )
104. {
105. # read cell from grid.
106. # cell refers to bottom level value of the grid, usually an array reference.
107. my $cell = $params->{grid}->[$row_i]->[$col_i];
108.
109. # assign fetch coderef.
110. my $fetch = ref $cell eq ref [ ] ? $cell->[0] : # cell is an array reference, therefore fetch coderef is the first element of that array reference.
111. defined $cell ? sub { $cell } : # cell is a defined value, therefore wrap that value in a coderef.
112. $params->{default_fetch} ; # none of the above, therefore fallback to default fetch coderef.
113.
114. # assign print coderef.
115. my $print = ref $cell eq ref [ ] ? $cell->[1] : # cell is an array reference, therefore fetch coderef is the second element of that array reference.
116. $params->{default_print} ; # none of the above, therefore fallback to default print coderef.
117.
118. # to avoid duplication, define some common params that we will pass to both the fetch and print coderefs.
119. # i refers to index i.e. 0 being the first or n - 1.
120. # n refers to number i.e. 1 being the first or i + 1.
121. # we have been using rows and cols by index up until this point for consistancy.
122. my $params_common =
123. {
124. row_i => $row_i,
125. row_n => $row_i + 1,
126. col_i => $col_i,
127. col_n => $col_i + 1,
128. };
129.
130. # fetch the val using the fetch coderef.
131. my $val = $fetch->( %$params_common );
132.
133. # print the val using the print coderef.
134. $print->( %$params_common, val => $val );
135.
136. # if printing to stdout for debug purposes, print a string that separates each col if we defined one and this isn't the last col.
137. print $params->{col_separator} if defined $params->{col_separator} and $col_i < $params->{max_col_i};
138. }
139.
140. # if printing to stdout for debug purposes, print a string that separates each row if we defined one and this isn't the last row.
141. print $params->{row_separator} if defined $params->{row_separator} and $row_i < $params->{max_row_i};
142. }
143.
144. return 1;
145. }
146.
147. ##################################################
148.
149. __END__


no markup for copying and pasting:

Code
use strict; 
use warnings FATAL => qw/all/;

##################################################
#
# declarations.
#

my $worksheet = undef; # to prevent error for now.

my $fetches =
{
default => sub { '' }, # default should return blank to assume empty cell.
dump => sub { "@_" },
row_i_col_i => sub { my $params = { @_ }; "$params->{row_i}, $params->{col_i}" },
};

my $prints_stdout =
{
default => sub { my $params = { @_ }; print $params->{val} },
string => sub { my $params = { @_ }; print $params->{val} },
};

my $prints_excel =
{
default => sub { my $params = { @_ }; $worksheet->write_string( $params->{row_i}, $params->{col_i}, $params->{val} ) },
string => sub { my $params = { @_ }; $worksheet->write_string( $params->{row_i}, $params->{col_i}, $params->{val} ) },
};

##################################################
#
# main.
#

print "begin\n\n";

my $grid = build_grid
(
fetches => $fetches,
prints => $prints_stdout,
);

print_worksheet
(
max_row_i => 30,
max_col_i => 10,
grid => $grid,
default_fetch => $fetches->{default},
default_print => $prints_stdout->{default}, # use $prints_excel when printing to excel.
row_separator => "\n", # likely want to undefine this when printing to excel.
col_separator => ' | ', # likely want to undefine this when printing to excel.
);

print "\n\nend";

##################################################
#
# functions.
#

# builds the grid arrayref.
sub build_grid
{
# convert @_ into a hashref.
my $params = { @_ };

# assign default values to params.
# note //= notation is not recognized earlier versions of Perl.
$params->{fetches} = { } unless defined $params->{fetches};
$params->{prints} = { } unless defined $params->{prints};

# define grid as an array reference.
my $grid = [ ];

# populate the grid with data, commonly using the design grid->[row_i]->[col_i] = [fetch, print].
$grid->[1]->[0] = [ $params->{fetches}->{row_i_col_i}, $params->{prints}->{string} ];
$grid->[1]->[3] = [ $params->{fetches}->{row_i_col_i}, $params->{prints}->{string} ];
$grid->[1]->[6] = [ $params->{fetches}->{row_i_col_i}, $params->{prints}->{string} ];
$grid->[1]->[8] = [ $params->{fetches}->{row_i_col_i}, $params->{prints}->{string} ];

return $grid;
}

# prints the worksheet.
sub print_worksheet
{
# convert @_ into a hashref.
my $params = { @_ };

# assign default values to params.
# note //= notation is not recognized in earlier versions of Perl.
$params->{max_row_i} = 0 unless defined $params->{max_row_i};
$params->{max_col_i} = 0 unless defined $params->{max_col_i};
$params->{grid} = [ ] unless defined $params->{grid};
$params->{default_fetch} = sub { '' } unless defined $params->{default_fetch};
$params->{default_print} = sub { print "@_" } unless defined $params->{default_print};
$params->{row_separator} = undef unless defined $params->{row_separator}; # pointless but here for completeness.
$params->{col_separator} = undef unless defined $params->{col_separator}; # pointless but here for completeness.

# loop through rows / cols.
for my $row_i ( 0 .. $params->{max_row_i} )
{
for my $col_i ( 0 .. $params->{max_col_i} )
{
# read cell from grid.
# cell refers to bottom level value of the grid, usually an array reference.
my $cell = $params->{grid}->[$row_i]->[$col_i];

# assign fetch coderef.
my $fetch = ref $cell eq ref [ ] ? $cell->[0] : # cell is an array reference, therefore fetch coderef is the first element of that array reference.
defined $cell ? sub { $cell } : # cell is a defined value, therefore wrap that value in a coderef.
$params->{default_fetch} ; # none of the above, therefore fallback to default fetch coderef.

# assign print coderef.
my $print = ref $cell eq ref [ ] ? $cell->[1] : # cell is an array reference, therefore fetch coderef is the second element of that array reference.
$params->{default_print} ; # none of the above, therefore fallback to default print coderef.

# to avoid duplication, define some common params that we will pass to both the fetch and print coderefs.
# i refers to index i.e. 0 being the first or n - 1.
# n refers to number i.e. 1 being the first or i + 1.
# we have been using rows and cols by index up until this point for consistancy.
my $params_common =
{
row_i => $row_i,
row_n => $row_i + 1,
col_i => $col_i,
col_n => $col_i + 1,
};

# fetch the val using the fetch coderef.
my $val = $fetch->( %$params_common );

# print the val using the print coderef.
$print->( %$params_common, val => $val );

# if printing to stdout for debug purposes, print a string that separates each col if we defined one and this isn't the last col.
print $params->{col_separator} if defined $params->{col_separator} and $col_i < $params->{max_col_i};
}

# if printing to stdout for debug purposes, print a string that separates each row if we defined one and this isn't the last row.
print $params->{row_separator} if defined $params->{row_separator} and $row_i < $params->{max_row_i};
}

return 1;
}

##################################################

__END__


First page Previous page 1 2 Next page Last page  View All
 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives