..per chi conosceva debianhardstyle sa per cosa è nato 😉

per chi non avesse voglia di fare copia e incolla

lo scarichi da qui

e invece per chi vuole vederselo online..

#!/usr/bin/perl
=head1 NAME
wg.pl

=head1 AUTHOR
Matteo Redaelli

E-MAIL: matteo.redaelli@libero.it

WEB:    http://digilander.iol.it/reda

=head1 DESCRIPTION
This is a Word Generator: you can apply some useful options to filter the

words
=head1 USAGE
type   perl wg.pl -h

=head1 HISTORY

2000-01-06: the first lines of this script
2000-01-11 added getopt
2000-01-21: adjusted default parameters
2002-03-05: new option -n
2002-03-06: new option -s
2002-03-07: reorganization of all source code, more documentation

=head1 LICENSE
This package is free software; you can redistribute it and/or

modify it under the same terms as Perl itself, i.e., under the

terms of the “Artistic License” or the “GNU General Public License”.

=head1 DISCLAIMER
This package is distributed in the hope that it will be useful,

but WITHOUT ANY WARRANTY; without even the implied warranty of

MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the “GNU General Public License” for more details.

=cut
use Getopt::Std;

use strict;

#use integer;
sub char2string

{

# string generator: if I pass ‘a’ and 5, I’ll get ‘aaaaa’

sprintf “%s”, @_[0]  x @_[1];

}
sub occurs

{

my $pat = @_[0];

my $astring = @_[1];
my $tot = $astring =~ s/$pat//g;
#    print “tot $tot\n”;

#

return $tot;

}
sub few_repeatitions

{

my $astring = @_[0];

my $max = @_[1];

my $len =  length( $astring );

my $tot = 0;
my $mid = int( $len / 2);

for ( my $step = 2; $step <= $mid; $step++) {

for ( 0 .. $len – $step ) {

my $letters = substr( $astring, $_, $step);

#    print “$letters\n”;

$tot = occurs( $letters, $astring);

return $tot if $tot > $max;

}

}

return 0;

}
sub nple

{

my $astring = @_[0];

my $len = length( $astring );

my $tot = 0;

my $in = 0;

my $last = ‘ ‘;

for ( 0 .. $len – 1) {

my $letter = substr( $astring, $_, 1);
#    print “$astring  $letter $last\n”;

if ( ($letter cmp $last)  == 0) {

#            print “$letter =  $last, $in, $tot”;

if ($in == 0) {

$in = 1;

$tot++;

}
} else {

$in = 0;

}

$last = $letter;

}

return $tot;
}
sub substring

{

my $string1 = @_[0];

my $string2 = @_[1];
$_ = $string2;
if ( /$string1/ ) {

return 0;

}

else {

return 1;

}

}

my %opts;
getopts(‘a:c:ehl:n:o:r:tu:v:z:’,  \%opts);

usage(0) if $opts{‘h’};

$opts{‘u’} and $opts{‘v’} or usage(1);
# setup parameters
my $va_list = $opts{‘v’};

my @va_list = split( //, $va_list ); # convert string to an array

my $min_depth = $opts{‘l’} ? int($opts{‘l’}) : 1;

my $max_depth = $opts{‘u’} ? int($opts{‘u’}) : 1;
usage(2) if $min_depth > $max_depth;
my $prefix = $opts{‘a’} ? $opts{‘a’} : ”;

my $postfix = $opts{‘z’} ? $opts{‘z’} : ”;

my $max_occurs = $opts{‘o’} ? int($opts{‘o’}) : $opts{‘u’};

my $max_cons = $opts{‘c’} ? int($opts{‘c’}) : $opts{‘u’};

my $max_nple =  $opts{‘n’};

my $max_reps =  $opts{‘r’};
usage(3) if $min_depth < 1 ||

$max_depth < 1 ||

$max_occurs < 1 ||

$max_cons < 1 ||

$max_nple < 0 ||

$max_reps < 0;
if ($opts{‘t’}) {

print “Options:\n”;

foreach my $key (sort keys %opts)

{ print “$key -> $opts{$key}\n”; }

print “Global vars:\n”;

print_vars();

}

for ($min_depth..$max_depth) {

wg( $_, “”);

}
sub print_vars

{

print “min_depth = $min_depth\n”;

print “max_depth =  $max_depth\n”;

print “max_occurs = $max_occurs\n”;

print “max_cons = $max_cons\n”;

print “max_nple = $max_nple\n”;

print “max_reps = $max_reps\n”;

}
#

# word generator

#

sub wg

{

my $max_depth = @_[0];

my $myprefix = @_[1];

my $elem;

if ($max_depth == 0 ) {

print “$prefix$myprefix$postfix\n”;

if ( $opts{e} == 1) {

system “$prefix$myprefix$postfix\n”;

}

}

else {

#        print ” n = $opts{‘n’} r = $opts{‘r’} \n”;

#

#        suggestion: the generation of the words is more variuos if

#        I change the order of the list of the letters (@va_list)
foreach $elem (@va_list) {
my $newstring = “$myprefix$elem”;

return if ( $opts{‘c’} &&

substring(char2string( $elem , $max_cons), $myprefix ) == 0);

return if(  $opts{‘n’} && nple( $newstring ) > $max_nple);

return if(  $opts{‘r’} &&

few_repeatitions( $newstring, $max_reps) != 0  );

return if ( $opts{‘o’} && occurs( “$elem”, $newstring) > $max_occurs );
wg( $max_depth -1, “$myprefix$elem”);
}

}

}
sub usage

{

my $rc = @_[0];
die <<END_USAGE
USAGE: perl $0 options
options are:

-a string: prefix

-c number: max consecutive letters (how many consecutive ‘a’ do you want?)

-e : submit the output string to the operating system

-h : help

-l number: min length of the word

-o number: max number of occurrencies of a letter

-n number: max number of n-ple  (AA, BBB, CCC, DDDD)

-r number: max number of repeatitions (ABCABABBCDBCD has 5 repeatitions: 3 reps of AB and 2 of BCD)

-t : trace on

-u number: max length of the word

-v string: list of valid characters (es, “01” “abcdef”)

-z string: postfix
possible return code are:

0, ok

1, not all parameters

2, min length (-l) is greater than max lenght (-u)

3, at least one parameter is lower than 1

Return code: $rc

END_USAGE
}

Advertisements