Bon,
I have this code which is a simple loop, which works… to call it you need to send it a reference to an array of numbers.
#blah = (0b0010,0b010,0b0111);
$ans = &logical_loop(\#blah);
sub logical_loop()
{
my $codes = $_[0];
my $ans = 0;
foreach (#$codes) {
printf "%b\n",$_;
$ans = ($ans | $_)
}
return($ans);
}
I wanted to make it recursive, so I wrote this code which doesn't work…. please can somebody tell me what I have missed? something to do with variables scopes perhaps?
sub recursive_loop
{
my $codes = $_[0];
my $el = shift #$codes;
if (#$codes == ()) {
return ($el | $answer);
} else {
$answer = (&recursive_loop(\#$codes) | $el);
}
}
sub recursive_loop {
return 0 unless #_;
my $head = shift;
return $head | recursive_loop(#_);
}
#blah = (0b0010,0b010,0b0111);
recursive_loop(#blah);
More efficient tail recursive:
sub or_it_up {
unshift #_, 0;
goto &recursive_loop;
}
sub recursive_loop {
my $ans = shift;
return $ans unless #_;
unshift #_, $ans | shift;
goto &recursive_loop;
}
#blah = (0b0010,0b010,0b0111);
or_it_up(#blah);
You can use calling recursive_loop as function but in this way it will not make stack frame.
You can also write it simply without or_it_up which serves just educational purpose. Calling recursive_loop directly will make result caused by nature of binary or.
I see a few problems with your subroutine.
its name contains a spacing mark
it doesn't call itself therefore no recursion is possible
Related
I have a module which is giving me the error "Can't locate object method "isSubset" via package "a" (perhaps you forgot to load "a"?) at /path/to/set.pm line 121.
SET.PM:
package set; #we will create set objects, instead of treating arrays as sets
sub new{
my $packagename = shift;
my #elements = #_;
bless { 'elements' => \#elements } => $packagename;
}
sub contains{
my $set = shift;
my ($element) = #_;
foreach ($set->elements){ if( $_ eq $element ){ return 1 } }
return 0
}
sub isElement{
my ($element,$set) = #_;
return $set->contains($element)
}
sub isSubset{
my $setA = shift;
my $setB = shift;
foreach ($setA->elements){ unless( isElement($_,$setB) ){ return 0 } }
return 1
}
*subset = *isContainedIn = *isContained = \&isSubset;
sub isSuperset{
my $setA = shift;
my $setB = shift;
return $setB->isSubset($setA) # this is line 121
}
*superset = *isContaining = *contains = \&isSuperset; # when i get rid of THIS line, it works fine.
When I comment out the last line, it works fine. Can you enlighten me on what is causing the failure? Am I using glob incorrectly?
CALLING PROGRAM:
my $a = set->new('a'..'g');
my $b = set->new('b'..'f');
print $a->isSubset($b);
Turn on warnings. Perl will tell you:
Subroutine set::contains redefined at ./1.pl line 44.
You use contains for testing both an element and a set.
I have one function sub _where(\# \&) which takes 2 arguments: the first is an array, and the second should be another function. This other function returns a boolean value, and I want to call it inside my for loop of sub _where(\# \&) function.
I am having trouble extracting the function I am passing in into a custom local name. I think I do need some local name for it, because it should be possible to pass different boolean functions to my where function.
where:
sub _where(\# \&)
{
my #stud = #{$_[0]};
my $student;
my $function = shift;
my $bool = 0;
my $i;
for $i(0..$#stud)
{
my $student = $stud[$i];
function $student;
}
}
Function1 that should be passed:
sub name_starts_with($)
{
my $letter = 'B';
my $student = shift;
my $first;
$first = substr($student -> name, 0, 1);
if($first eq $letter)
{
return 1;
}
}
Function2 that should be passed to where:
sub points_greater_than($)
{
my $sum_pts = 5;
my $student = shift;
my $pts;
$pts = $student -> points;
if($pts > $sum_pts)
{
return 1;
}
}
Hope you guys could help me out here. Cheers
You shouldn't use prototypes. They work differently in Perl from other languages and are almost never a good choice.
You should also avoid making a local copy of the passed-in array unless you want to modify it without affecting the external data.
Finally, a subroutine name beginning with an underscore usually indicates that it is a private method of a class. It doesn't look like that's the case here.
Your code should look like this
sub _where {
my ($stud, $function) = #_;
my $student;
my $bool = 0;
for my $i (0..$#stud) {
my $student = $stud->[$i];
$function->($student);
}
}
Then you can call it as
_where(\#student, \&function);
One problem is in how you get parameters:
my #stud = #{$_[0]}; # <-- this doesn't remove first parameter from list
my $student;
my $function = shift; # <-- therefore you'll still get first parameter, not second
Try this fix:
my $function = $_[1]; # always get second parameter
Update
Adding example of how to pass reference to function into other function:
_where(\#stud, \&name_starts_with);
You seem to be trying to write another language in Perl. Ick. Try this:
sub _where
{
my $students = shift;
my $function = shift;
$function->($_) for #$students;
}
sub name_starts_with
{
my $student = shift;
my $letter = 'B';
my $first = substr($student->name, 0, 1);
return $first eq $letter; # same as 'return $first eq $letter ? 1 : undef;'
}
sub points_greater_than
{
my $student = shift;
my $sum_pts = 5;
my $pts = $student->points;
return $pts > $sum_pts;
}
And you would call it like _where(\#students, \&name_starts_with).
But I'm not exactly what the purpose of your _where function is, as it does not return anything (except the last statement evaluated, which doesn't seem too useful in this context).
Maybe you just want grep?
my #students_b = grep { substr($_->name, 0, 1) eq 'B' } #students;
You have bug in argument handling in function _where. You are putting array reference into $function variable. You have to do
my #stud = #{shift()};
my $student;
my $function = shift();
or
my #stud = #{$_[0]};
my $student;
my $function = $_[1];
or which I would prefer
sub _where(\# \&)
{
my ($stud, $function) = #_;
for my $student (#$stud)
{
$function->($student);
}
}
but don't mix those methods.
After you fix the problem with grabbing the first argument, here are three ways to call a subroutine from a code reference:
&$function($student); # uses the fewest characters!
&{$function}($student); # the style you're using for the array ref
$function->($student); # my favorite style
You can find a lot more detailed information by reading the perlref man page.
If you change the order of the arguments so that the coderef is first, your code will be a little bit more Perlish.
sub _where(\&#){
my $func = shift;
my #return;
for(#_){
push #return, $_ if $func->($_);
}
return #return;
}
If you were well versed in Perl, you would notice that I just re-implemented grep (poorly).
sub name_starts_with{
'B' eq substr($_->name, 0, 1);
}
sub points_greater_than{
$_->points > 5;
}
my #b_students = _where( &name_starts_with, #students );
my $count_of_students_above_5 = _where( &points_greater_than, #students );
Since those subroutines now rely on $_, we should just use grep.
my #b_students = grep( &name_starts_with, #students );
my $count_of_students_above_5 = grep( &points_greater_than, #students );
Since those subroutines are also very short, how about just using a block.
my #b_students = grep {
'B' eq substr($_->name, 0, 1)
} #students;
my $count_of_students_above_5 = grep {
$_->points > 5;
} #students;
I am a newbie in newbies for perl. I am trying to create a function which returns the value of the hash. The following piece of code simply returns the last index of the hash. I googled around and couldnt find what i need. Appreciate if anyone can tell me where I am going wrong.
I am expecting, if I pass "he_1", I should get a return back value of 1, etc.. but all I see is 9.
#!/usr/bin/perl
my %IndexMap = ();
my $MAX_V = 5;
my $MAX_T = 10;
sub InitIndexMap {
foreach my $i (0..$MAX_V-1) {
$IndexMap["he_".$i] = $i;
print "he_".$i;
print $IndexMap["he_".$i];
}
foreach my $i ($MAX_V..$MAX_T-1) {
$IndexMap["un".$i] = $i;
print "un".$i;
print $IndexMap["un".$i];
}
}
sub GetVal {
my ($name) = #_;
return $IndexMap[$name];
}
&InitIndexMap();
my ($index) = &Getval("he_4");
print $index;
To read a hash, use curly braces, not brackets. Try this:
sub InitIndexMap {
foreach my $i (0..$MAX_V-1) {
$IndexMap{ "he_" . $i } = $i;
print "he_".$i;
print $IndexMap{ "he_" . $i };
}
foreach my $i ($MAX_V..$MAX_T-1) {
$IndexMap{ "un" . $i } = $i;
print "un".$i;
print $IndexMap{ "un" . $i };
}
}
sub GetVal {
my ( $name ) = #_;
return $IndexMap{ $name };
}
You should add this to the top of the script:
use strict;
use warnings;
The general rule to always turn those pragmas. They warnings and errors that that cause would have probably led you to the answer to your question.
You should access hashes with curly brackets like { and }.
$hash_name{$key} = $value;
In your example.
$IndexMap{"he_".$i} = $i;
You should consider doing some tutorials.
This is VERY BASIC knowledge in Perl.
I am working on a very large, very old "historically grown" codebase. In the past, there were often people thinking "Oh, I may need this and that module, so I just include it...", and later, people often "cached" Data inside of modules ("use ThisAndThat" needing a few seconds to load some hundred MB from DB to RAM, yeah, its really a stupid Idea, we are working on that too) and so, often, we have a small module use'ing like 20 or 30 modules, from who 90% are totally unused in the source itself, and, because of "caching" in several use'd submodules, modules tend to take up one minute to load or even more, which is, of course, not acceptable.
So, Im trying to get that done better. Right now, my way is looking through all the modules, understanding them as much as possible and I look at all the modules including them and see whether they are needed or not.
Is there any easier way? I mean: There are functions returning all subs a module has like
...
return grep { defined &{"$module\::$_"} } keys %{"$module\::"}
, so, aint there any simple way to see which ones are exported by default and which ones come from where and are used in the other modules?
A simple example is Data::Dumper, which is included in nearly every file, even, when all debug-warns and prints and so on arent in the script anymore. But still the module has to load Data::Dumper.
Is there any simple way to check that?
Thanks!
The following code could be part of your solution - it will show you which symbols are imported for each instance of use:
package traceuse;
use strict;
use warnings;
use Devel::Symdump;
sub import {
my $class = shift;
my $module = shift;
my $caller = caller();
my $before = Devel::Symdump->new($caller);
my $args = \#_;
# more robust way of emulating use?
eval "package $caller; require $module; $module\->import(\#\$args)";
my $after = Devel::Symdump->new($caller);
my #added;
my #after_subs = $after->functions;
my %before_subs = map { ($_,1) } $before->functions;
for my $k (#after_subs) {
push(#added, $k) unless $before_subs{$k};
}
if (#added) {
warn "using module $module added: ".join(' ', #added)."\n";
} else {
warn "no new symbols from using module $module\n";
}
}
1;
Then just replace "use module ..." with "use traceuse module ...", and you'll get a list of the functions that were imported.
Usage example:
package main;
sub foo { print "debug: foo called with: ".Dumper(\#_)."\n"; }
use traceuse Data::Dumper;
This will output:
using module Data::Dumper added: main::Dumper
i.e. you can tell which functions were imported in robust way. And you can easily extend this to report on imported scalar, array and hash variables - check the docs on Devel::Symdump.
Determine which functions are actually used is the other half of the equation. For that you might be able to get away with a simple grep of your source code - i.e. does Dumper appear in the module's source code that's not on a use line. It depends on what you know about your source code.
Notes:
there may be a module which does what traceuse does - I haven't checked
there might be a better way to emulate "use" from another package
I kind of got of got it to work with PPI. It looks like this:
#!/usr/local/bin/perl
use strict;
use warnings;
use Data::Dumper;
use Term::ANSIColor;
use PPI;
use PPI::Dumper;
my %doneAlready = ();
$" = ", ";
our $maxDepth = 2;
my $showStuffOtherThanUsedOrNot = 0;
parse("/modules/Test.pm", undef, undef, 0);
sub parse {
my $file = shift;
my $indent = shift || 0;
my $caller = shift || $file;
my $depth = shift || 0;
if($depth && $depth >= $maxDepth) {
return;
}
return unless -e $file;
if(exists($doneAlready{$file}) == 1) {
return;
}
$doneAlready{$file} = 1;
my $skript = PPI::Document->new($file);
my #included = ();
eval {
foreach my $x (#{$skript->find("PPI::Statement::Include")}) {
foreach my $y (#{$x->{children}}) {
push #included, $y->{content} if (ref $y eq "PPI::Token::Word" && $y->{content} !~ /^(use|vars|constant|strict|warnings|base|Carp|no)$/);
}
}
};
my %double = ();
print "===== $file".($file ne $caller ? " (Aufgerufen von $caller)" : "")."\n" if $showStuffOtherThanUsedOrNot;
if($showStuffOtherThanUsedOrNot) {
foreach my $modul (#included) {
next unless -e createFileName($modul);
my $is_crap = ((exists($double{$modul})) ? 1 : 0);
print "\t" x $indent;
print color("blink red") if($is_crap);
print $modul;
print color("reset") if($is_crap);
print "\n";
$double{$modul} = 1;
}
}
foreach my $modul (#included) {
next unless -e createFileName($modul);
my $anyUsed = 0;
my $modulDoc = parse(createFileName($modul), $indent + 1, $file, $depth + 1);
if($modulDoc) {
my #exported = getExported($modulDoc);
print "Exported: \n" if(scalar #exported && $showStuffOtherThanUsedOrNot);
foreach (#exported) {
print(("\t" x $indent)."\t");
if(callerUsesIt($_, $file)) {
$anyUsed = 1;
print color("green"), "$_, ", color("reset") if $showStuffOtherThanUsedOrNot;
} else {
print color("red"), "$_, ", color("reset") if $showStuffOtherThanUsedOrNot;
}
print "\n" if $showStuffOtherThanUsedOrNot;
}
print(("\t" x $indent)."\t") if $showStuffOtherThanUsedOrNot;
print "Subs: " if $showStuffOtherThanUsedOrNot;
foreach my $s (findAllSubs($modulDoc)) {
my $isExported = grep($s eq $_, #exported) ? 1 : 0;
my $rot = callerUsesIt($s, $caller, $modul, $isExported) ? 0 : 1;
$anyUsed = 1 unless $rot;
if($showStuffOtherThanUsedOrNot) {
print color("red") if $rot;
print color("green") if !$rot;
print "$s, ";
print color("reset");
}
}
print "\n" if $showStuffOtherThanUsedOrNot;
print color("red"), "=========== $modul wahrscheinlich nicht in Benutzung!!!\n", color("reset") unless $anyUsed;
print color("green"), "=========== $modul in Benutzung!!!\n", color("reset") if $anyUsed;
}
}
return $skript;
}
sub createFileName {
my $file = shift;
$file =~ s#::#/#g;
$file .= ".pm";
$file = "/modules/$file";
return $file;
}
sub getExported {
my $doc = shift;
my #exported = ();
eval {
foreach my $x (#{$doc->find("PPI::Statement")}) {
my $worthATry = 0;
my $isMatch = 0;
foreach my $y (#{$x->{children}}) {
$worthATry = 1 if(ref $y eq "PPI::Token::Symbol");
if($y eq '#EXPORT') {
$isMatch = 1;
} elsif($isMatch && ref($y) ne "PPI::Token::Whitespace" && ref($y) ne "PPI::Token::Operator" && $y->{content} ne ";") {
push #exported, $y->{content};
}
}
}
};
my #realExported = ();
foreach (#exported) {
eval "\#realExported = $_";
}
return #realExported;
}
sub callerUsesIt {
my $subname = shift;
my $caller = shift;
my $namespace = shift || undef;
my $isExported = shift || 0;
$caller = `cat $caller`;
unless($namespace) {
return 1 if($caller =~ /\b$subname\b/);
} else {
$namespace = createPackageName($namespace);
my $regex = qr#$namespace(?:::|->)$subname#;
if($caller =~ $regex) {
return 1;
}
}
return 0;
}
sub findAllSubs {
my $doc = shift;
my #subs = ();
eval {
foreach my $x (#{$doc->find("PPI::Statement::Sub")}) {
my $foundName = 0;
foreach my $y (#{$x->{children}}) {
no warnings;
if($y->{content} ne "sub" && ref($y) eq "PPI::Token::Word") {
push #subs, $y;
}
use warnings;
}
}
};
return #subs;
}
sub createPackageName {
my $name = shift;
$name =~ s#/modules/##g;
$name =~ s/\.pm$//g;
$name =~ s/\//::/g;
return $name;
}
Its really ugly and maybe not 100% working, but it seems, with the tests that Ive done now, that its good for a beginning.
If I have the following code
sub a {
my $id = shift;
# does something
print &a_section($texta);
print &a_section($textb);
sub a_section {
my $text = shift;
# combines the $id and the $text to create and return some result.
}
}
Assuming a_section is called only by a, will I run into a memory leak, variable dependability, or other problem?
I am exploring this as an alternative so I can avoid the necessity of passing $id to a_section.
First, it's not a private sub. It's fully visible from the outside. Two, you will have problems.
$ perl -wE'
sub outer {
my ($x) = #_;
sub inner { say $x; }
inner();
}
outer(123);
outer(456);
'
Variable "$x" will not stay shared at -e line 4.
123
123 <--- XXX Not 456!!!!
You could do:
sub a {
my $id = shift;
local *a_section = sub {
my $text = shift;
# combines the $id and the $text to create and return some result.
};
print a_section($texta);
print a_section($textb);
}
(You can call the inner sub recursively using a_section(...).)
or:
sub a {
my $id = shift;
my $a_section = sub {
my $text = shift;
# combines the $id and the $text to create and return some result.
};
print $a_section->($texta);
print $a_section->($textb);
}
(Use __SUB__->(...) if you want to call the inner sub recursively to avoid memory leak, available in Perl 5.16+.)