Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Cool Uses for Perl

( #1044=superdoc: print w/ replies, xml ) Need Help??

This section is the place to post your general code offerings -- everything from one-liners to full-blown frameworks and apps.

CUFP's
Automate multi-perl unit testing with Perlbrew/Berrybrew
No replies — Read more | Post response
by stevieb
on Feb 09, 2016 at 14:18

    Recently, in Re: Testing in Perl, I said I was working on a script that automates multiple test builds of a module against a number of Perlbrew instances. Below are the brew_build.pl (brew control) script and the test.pl (test runner) script, and here's the git repo.

    This works on all platforms I've tested it on (FreeBSD, Linux and Windows). For *nix, you need to have Perlbrew installed. On Windows, Berrybrew is required. You'll also require cpanm from App::cpanminus.

    The reasoning behind this creation is due to the fact Travis CI only performs builds on Linux machines, and I wanted an easy way to perform release candidate builds on Windows as well in much the same manner.

    It was rather quickly slapped together, but it's simply a prototype. Now that I know it works pretty well, I'm going to turn it into a proper Test module.

    In your module, create a build directory in the root, and drop these two files into it. Here are some usage examples:

    Run unit tests on all currently installed perl versions:

    perl build/brew_build.pl

    Remove all currently installed perl instances (except the one you're using), and install three new random versions, and run tests on those pristine instances (short forms for args (eg: -c for --count) are available:

    perl build/brew_build.pl --reload 1 --count 3

    Install all versions of perl available to Perlbrew, without removing existing instances, and enable verbose output:

    perl build/brew_build.pl -d 1 -c -1

    Install a specific version of perl, and run tests on all installed versions:

    perl build/brew_build.pl -v 5.20.1

    Example output (note that if one perlbrew instance fails tests, all processing stops (exit;) and the actual test output for the failed build is displayed along with the perl version so you can further investigate. Otherwise, on success:

    % perl build/brew_build.pl perl-5.23.7 perl-5.22.1 perl-5.20.3 perl-5.18.4 perl-5.14.4 perl-5.12.5 perl-5.12.5 :: PASS perl-5.14.4 :: PASS perl-5.18.4 :: PASS perl-5.20.3 :: PASS perl-5.22.1 :: PASS perl-5.23.7 :: PASS

    brew_build.pl

    #!/usr/bin/perl use warnings; use strict; use Cwd; use Getopt::Long; my ($debug, $count, $reload, $version, $help); GetOptions( "debug=i" => \$debug, "count=i" => \$count, "reload=i" => \$reload, "version=s" => \$version, "help" => \$help, ); if ($help){ print <<EOF; Usage: perl build/brewbuild.pl [options] Options: --debug | -d: Bool, enable verbosity --count | -c: Integer, how many random versions of perl to insta +ll. Send in -1 to install all available versions. --reload | -r: Bool, remove all installed perls (less the current + one) before installation of new ones --verion | -v: String, the number portion of an available perl ve +rsion according to "perlbrew available" Note that only o +ne is allowed at this time --help | -h: print this help message EOF exit; } my $cwd = getcwd(); my $is_win = 0; $is_win = 1 if $^O =~ /Win/; run($count); sub perls_available { my $brew_info = shift; my @perls_available = $is_win ? $brew_info =~ /(\d\.\d+\.\d+_\d+)/g : $brew_info =~ /(perl-\d\.\d+\.\d+)/g; if ($is_win){ for (@perls_available){ s/perl-//; } } return @perls_available; } sub perls_installed { my $brew_info = shift; return $is_win ? $brew_info =~ /(\d\.\d{2}\.\d(?:_\d{2}))(?!=_)\s+\[installed +\]/ig : $brew_info =~ /i.*?(perl-\d\.\d+\.\d+)/g; } sub instance_remove { my @perls_installed = @_; if ($debug) { print "$_\n" for @perls_installed; print "\nremoving previous installs...\n"; } my $remove_cmd = $is_win ? 'berrybrew remove' : 'perlbrew uninstall'; for (@perls_installed){ my $ver = $^V; $ver =~ s/v//; if ($_ =~ /$ver$/){ print "skipping version we're using, $_\n" if $debug; next; } `$remove_cmd $_`; } print "\nremoval of existing perl installs complete...\n" if $debu +g; } sub instance_install { my $count = shift; my @perls_available = @_; my $install_cmd = $is_win ? 'berrybrew install' : 'perlbrew install --notest -j 4'; my @new_installs; if ($version){ $version = $is_win ? $version : "perl-$version"; push @new_installs, $version; } else { if ($count) { while ($count > 0){ push @new_installs, $perls_available[rand @perls_avail +able]; $count--; } } } if (@new_installs){ for (@new_installs){ print "\ninstalling $_...\n"; `$install_cmd $_`; } } else { print "\nusing existing versions only\n" if $debug; } } sub results { my $exec_cmd = $is_win ? "berrybrew exec perl $cwd\\build\\test.pl" : "perlbrew exec perl $cwd/build/test.pl 2>/dev/null"; my $debug_exec_cmd = $is_win ? "berrybrew exec perl $cwd\\build\\test.pl" : "perlbrew exec perl $cwd/build/test.pl"; my $result; print "\n...executing\n" if $debug; if ($is_win){ $result = `$exec_cmd`; } else { if ($debug){ $result = `$debug_exec_cmd`; } else { $result = `$exec_cmd`; } } my @ver_results = split /\n\n\n/, $result; print "\n\n"; for (@ver_results){ my $ver; if (/^([Pp]erl-\d\.\d+\.\d+)/){ $ver = $1; } my $res; if (/Result:\s+(PASS)/){ $res = $1; } else { print $_; exit; } print "$ver :: $res\n"; } } sub run { my $count = shift // 0; my $brew_info = $is_win ? `berrybrew available` : `perlbrew available`; my @perls_available = perls_available($brew_info); $count = scalar @perls_available if $count < 0; my @perls_installed = perls_installed($brew_info); print "$_\n" for @perls_installed; if ($debug){ print "$_ installed\n" for @perls_installed; print "\n"; } my %perl_vers; instance_remove(@perls_installed) if $reload; instance_install($count, @perls_available); results(); }

    test.pl

    #!/usr/bin/perl use warnings; use strict; use Cwd; my $cwd = getcwd(); if ($^O ne 'MSWin32'){ system "cpanm --installdeps . && make && make test"; } else { system "cpanm --installdeps . && dmake && dmake test"; }
Do we have the same processes running before and after an upgrade?
No replies — Read more | Post response
by j0se
on Feb 09, 2016 at 10:20

    A little tool to help you with a Linux distribution upgrade (like apt-get dist-upgrade). The code and the story behind.

    It's nice to be important, but it's more important to be nice. -- Tommy
raffle_tickets_generator
4 direct replies — Read more / Contribute
by QuillMeantTen
on Dec 03, 2015 at 04:20

    Greetings fellow monks,

    Yesterday my lady asked me if I could do her a favor, gallant fool that I am I answered at once

    "Of course, my paramour, it would be my honor to take on any quest, to slay any foe metaphorical or otherwise for your honor". For my defense the day before I forgot to make her lasagnas as promised and she was quite disappointed with my chicken and mushroom pie so that's why I did not ask what the task would be before accepting.

    A strange activity was asked of me : writing raffle tickets with nice images in such a way that they could be easily printed and then cut out as individual tickets.
    As more than 3 hundreds of them were required by 6 pm the same day (someone had dumped the task on her without warning) she told me that using Excel was a solution but as it was computer related she hoped I knew some wizardry to accomplish the task in mere moments.

    So I grabbed my spear, shield, poleaxe, steed and my trusted GCC (gnu compiler cat, an universal syntax checker that will sit on my lap while I code and try to rip my throat if I move and sometimes when I make syntax mistakes)

    I soon came up with this idea : Write it using latex, break the latex doc in discrete parts and then use a perl script to rearrange them as needed

    Here is the resulting script : you give it a path to the image you want, the number of tickets you want and the scale for the image and you should (hopefully) get some kind of result.
    Also you will need pdflatex.
    As usual, I'm looking for ways to get better so constructive criticism is welcome.

    Update: added autodie, thanks athanasius
    use constant, rewrite the first loop, thanks anonymous monk, I'm going to read on the use of the DATA section

Emulating Python's unittests MagicMock
1 direct reply — Read more / Contribute
by stevieb
on Nov 29, 2015 at 11:18

    Update: Mock::Sub. I haven't documented well the difference between OO and imported functions, so see EXAMPLES for the caveat for now. /Update

    I've been writing a lot of unit tests in Python lately, and really took to liking the MagicMock module. This morning, I thought I'd take a crack to see if I could emulate much of its functionality, before I write a full-blown module for it. So far, it implements called(), call_count(), side_effect and return_value:

    The Module itself (./Test/MockSub.pm):

    package Test::MockSub; sub mock { my $self = bless {}, shift; my $sub = shift; %{ $self } = @_; if (defined $self->{return_value} && defined $self->{side_effect}) +{ die "use only one of return_value or side_effect"; } my $called; { no strict 'refs'; *$sub = sub { $self->{call_count} = ++$called; return $self->{return_value} if defined $self->{return_val +ue}; $self->{side_effect}->() if $self->{side_effect}; }; } return $self; } sub called { return shift->call_count ? 1 : 0; } sub call_count { return shift->{call_count}; } sub reset { my $self = shift; delete $self->{$_} for keys %{ $self }; } 1;

    The outer module I'm calling the inner module with mocked subs from (./MyPackage.pm):

    package MyPackage; use lib '.'; use One; sub test { my $obj = One->new; $obj->foo; } 1;

    The inner module I'm mocking (./One.pm):

    package One; sub new { return bless {}, shift; } sub foo { print "in One::foo\n"; } 1;

    ... and finally the script I'm testing it all from:

    use warnings; use strict; use feature 'say'; use lib '.'; use Test::MockSub; use MyPackage; {# called() && call_counnt() my $foo = Test::MockSub->mock('One::foo'); MyPackage::test; MyPackage::test; my $count = $foo->call_count; say "testing call_count(): $count"; my $called = $foo->called; say "testing called(): $called"; } {# return_value my $foo = Test::MockSub->mock('One::foo', return_value => 'True'); my $ret = MyPackage::test; say "testing return_value: $ret"; } {# side_effect my $cref = sub {die "thowing error";}; my $foo = Test::MockSub->mock('One::foo', side_effect => $cref); eval{MyPackage::test;}; print "testing side_effect: "; say $@ ? 'success' : 'failed'; } {# side_effect && return_value dies() my $foo; my $cref = sub {}; eval{ $foo = Test::MockSub->mock('One::foo', side_effect => $cref, r +eturn_value => 1);}; print "testing side_effect & return_value dies(): "; say $@ ? 'success' : 'failed'; } {# reset() my $foo = Test::MockSub->mock('One::foo', return_value => 1); my $ret1 = MyPackage::test; $foo->reset; my $ret2 = MyPackage::test; print "testing reset():"; say defined $ret1 && ! defined $ret2 ? 'success' : 'failed'; }

    There's Test::MockModule and Test::MockObject, but I like the built-in methods, and how I've done it allows for mocking functions, class methods and object methods all at the same time (at least I think).

    Thoughts, criticism and feedback welcome as always.

Restarting File::Find
1 direct reply — Read more / Contribute
by Preceptor
on Nov 24, 2015 at 06:44

    One of the problems I've had in the past, is a need to walk a filesystem and 'batch up' files. There's a variety of reasons why - things like archiving, virus scanning, etc. Now, you _could_ do it the heavyweight way - collect a full tree directory structure, batch up that way. This didn't suit my needs - I've a billion ish files to inspect, and they change rather frequently.

    So as a workaround - make use of File::Find and it's ability to prune

    #!/usr/bin/env perl use strict; use warnings; use File::Find; my $start_from = "/path/to/search/some_dir/beneath"; my $count = 10_000; #how many files to grab in this 'batch'; my @file_list; sub finder { if ( defined $start_from and not $found ) { #partial match, walk directory. if ( $start_from =~ m/\QFile::Find::name/ ) { $File::Find::prune = 0; if ( $File::Find::name =~ m/\Q$start_from/ ) { $found = 1; } } else { $File::Find::prune = 1; #don't traverse into this dir } } if ( @file_list > $limit ) { $found = 0; $File::Find::prune = 1; return; } return unless -f $File::Find::name; push ( @file_list, $File::Find::name ); #backtracks a bit to the start of the current directory $start_from = $File::Find::dir; } find ( \&finder, '/path/to/search' ); print "Next start point: $start_from\n";

    Note - as it stands, this has a limiting factor in that it'll misbehaving if the directory structure changes (e.g. $start_from no longer exists. The workaround is chopping path elements off the end until you get to a dir that _does_ exist.

    Probably something like:

    while ( not -d $start_from and $start_from =~ m,/, ) { $start_from =~ s,/[^/]+$,,; }

    (There's probably a better solution using File::Spec or similar)

Subimage replacement script
1 direct reply — Read more / Contribute
by ohcamacj
on Nov 16, 2015 at 00:37

    I have more respect for OCR software now.

    Recently, trying to practice memorizing simple visual substitution ciphers; wrote a subimage replacement script that as input, takes

    • a directory containing lotsa tiny images. In my particular case, 156 carefully cropped screenshots. Upper and lowercase letters (26 + 26), bold letters (26 + 26), and underlined letters (26 + 26). Some repetation, but mostly a lot of time in the gimp; and using screenshots of partially highlighted / partially inverse colors text to figure out where the character boundries were. And also, images representing the replacement characters. In my case, 26 images and 130 symlinks -- the replacements are not case, bold, or underlined sensitive.
    • a single screenshot of an xterm, containing text in a monospace font without antialiasing.
    and outputs
    • a slightly distorted (in my case, replacements are larger than the originals; 8x20 vs. 6x13) image of the original text, with the simple visual substitution cipher applied.

    My script, has a few features that aren't strictly necessary for plain OCR of monospaced text in a known font at a known initial starting offset.

    • Pixel stepping scan mode. Until the first 10 characters are found, it steps pixel by pixel through the image; and only after that; starts jumping in 6x13 blocks.
    • color insensitivity and preservation. On colored or inverse colored text, remaps the replacement character, to the original colors; on a character by character basis.
    • image stretching. Having the replacement images (8x20) being slightly larger than the originals (6x13) added a bit of complexity.
    • high memory consumption. Only color format used is 24-bit, even though only 1.6 bits per pixel, are actually used (3 colors).

    And, what gives me much more respect for OCR software now, than before I started; is that the initial pixel stepping scan mode; prior to finding the first ten characters; is very slow.

    This code probably won't be useful to anyone else, because

    • nobody else has patience to spend a few hours in the gimp cropping screenshots of individual letters.
    • anyone smarter than me; probably would have modified font rendering from the very bottom -- font files -- instead of the very top -- screenshots. And starting from the very bottom, lets you skip the OCR-ish step entirely.

    It's also, sorta unclear and hard to read, due to misleading comments, and overuse of the comment-blocks-for-version-control design antipattern. Anyway,

    See also, soylentnews journal post #1, soylentnews journal post #2

Mollie Payment without Business::MollieAPI
No replies — Read more | Post response
by Beatnik
on Nov 13, 2015 at 03:57
    So I was looking at adding credit card payments to some site I'm building. Mollie.com seems like a nice platform but after checking out Business::MollieAPI (albeit really quickly) I decided not to go there and use a straight approach. The code below can run as a CGI script (add some CGI.pm magic) and uses a test key to issue a token, simulate a payment and confirm the payment. It's relatively straightforward if you look at the API documentation they offer on-line. Step 1: send an amount and description to the API, together with a redirect URL (on success and failure) and receive a token to confirm payment. Step 2: Pay. The returned URL will load a payment page at Mollie.com and will redirect to your chosen page. Store the ID prior to paying since you will need it to confirm the payment. Step 3: Confirm the payment status.
    #!/usr/bin/perl use LWP::UserAgent; use HTTP::Request; use JSON::XS qw(decode_json encode_json); use Data::Dumper; use strict; my $key = "test_GETYOURTESTKEYONTHEWEBSITE"; sub confirm # Argument: Mollie Transaction { my $transaction = shift @_; # Mollie will generate unique transactio +n ID prior to payment my $req = HTTP::Request->new('GET'=>"https://api.mollie.nl/v1/paymen +ts/$transaction"); $req->header('Authorization', 'Bearer ' . $key); my $ua = LWP::UserAgent->new(); my $res = $ua->request($req); if ($res->is_success) { my $data = decode_json($res->decoded_content); return $data->{'status'}; # 'paid' for OK, 'cancelled' for cancell +ed. } else { die Dumper $res; # Something else is going on } } sub pay # Arguments: Amount & Description { my $amount = shift; my $description = shift; my $req = HTTP::Request->new('POST'=>'https://api.mollie.nl/v1/payme +nts'); $req->header('Authorization', 'Bearer ' . $key); $req->content_type('application/json'); my %payment = ("amount"=>$amount,"description"=>$description,"redire +ctUrl"=>"http://www.somesite.com/cgi-bin/somescript.cgi"); # Trigger +confirmation here my $json = encode_json(\%payment); $req->content(encode_json(\%payment)); my $ua = LWP::UserAgent->new(); my $res = $ua->request($req); if ($res->is_success) { my $data = decode_json($res->decoded_content); my $url = $data->{'links'}{'paymentUrl'}; # On-line payment proces +s my $paymentid = $data->{'id'}; return $paymentid, $url; } else { die Dumper $res; # Something else is going on } } my ($id, $url) = &pay(100,"Lego Star Wars"); # Load URL and pay the money! my ($status) = &confirm($id); # Unique and temporary ID for transactio +n if ($status eq "paid") { print "RRRAARRWHHGWWR"; } # Walking Carpet Joke else { print "These are not the droids you're looking for!"; }


    Greetz
    Beatnik
    ... I'm belgian but I don't play one on TV.
Minimal, %ENV based templating tool
1 direct reply — Read more / Contribute
by blindluke
on Nov 08, 2015 at 09:12

    There is a nice, minimal templating tool out there, called skel. Its author, Scott Vokes, describes it as a "tiny command-line skeleton/snippet thing", and it's probably accurate.

    Given a template file name, it expands all the occurences of #{VARIABLE} with the value obtained from the %ENV.

    The tool has proven quite useful to me, mostly due to the way it provides a lot of useful features while still allowing you to use it in the most primitive way imaginable.

    Inspired by the simplicity of it, I tried rewriting the most basic version of the idea in Perl, adding the one (the only?) feature I was missing - asking for variable values when the ENV var is unset.

    #!/usr/bin/perl use v5.14; my %cfg = ( tmpl_path => $ENV{HOME}.'/.skel-closet/', opening_tag => '#{', closing_tag => '}', ); sub prompt { my $msg = shift; local $| = 1; local $\; warn "$msg \n"; my $ans = <STDIN>; defined $ans ? chomp $ans : warn "\n"; return $ans; } sub filled_line { my $line = shift; my $pattern = qr/$cfg{opening_tag}(.+?)$cfg{closing_tag}/; $line =~ s/$pattern/$ENV{$1} ? $ENV{$1} : prompt("$1 unset. Value: +") /eg; return $line; } my $filename = $cfg{tmpl_path}.shift; open (my $fh, '<', $filename) or die ("Could not open file: $filename"); my @output; while (<$fh>) { push @output, filled_line($_); } close ($fh); print for @output;

    The use is straightforward. Here's an example:

    $ cat ~/.skel-closet/test This is the value of HOME: #{HOME} This is the value of EDITOR: #{EDITOR} This is the value of FOO: #{FOO} $ ./pskel.pl test > out.txt FOO unset. Value: foovalue $ cat out.txt This is the value of HOME: /home/blj This is the value of EDITOR: emacs This is the value of FOO: foovalue

    - Luke

ciscodump - dump config info from routers into files
2 direct replies — Read more / Contribute
by soonix
on Nov 05, 2015 at 09:59

    This is a script for reading config info from a bunch of routers (for archiving, autiting, whatever)

    The configuration for the script itself is read from a INI-style config file (example below). Each router is represented by a section with its name or IP as the section header. The "info" attribute is mandatory (originally intended as title information for a to-be-generated report). Then there has to be a section "dump" (which means if you have a router with a hostname of "dump", you have to refer to it by its IP address).

    Each entry in the "dump" section results in a command sent to the router(s), and the output of this command is written to a file.

    The output is placed in the directory named by "dir" in the top INI section. Each router gets its own subdirectory, and if set "debug", there will be a subdirectory "debug" - so you should not use "debug" as hostname, either :-)

    The "enable" password is needed, because on Cisco devices, the terminal size command is privileged.

    Initially, I used Net::Telnet::Cisco, and later adapted it for SSH. After trying with SSH modules directly, I settled with Control::CLI. It took me a while noticing that they use different ways of to specify prompts, before getting it to work.

    Of course it is bad to have passwords stored as plaintext, but at least they are kept separate from the script itself. It runs under Windows, but should work under other systems, too.

    Additionally, I uploaded it to a github gist, just in case someone wants to tinker.

Yet Another threaded find|grep perl utility
6 direct replies — Read more / Contribute
by QuillMeantTen
on Nov 04, 2015 at 06:10

    Greetings, fellow monks
    Today I was given a C assignment : writing a program that once given a top directory to search, a filename to search for and a max number of coexisting threads will return the absolute path of the file if it is found inside the directory or the paths of multiple similarly named files

    The assignment is quite specific on the way it should be done:

    A main thread creates a named pipe and then uses it to receive subdirectory paths. Those subdirectory paths are used to create new threads that will look for the specified filename inside the directory and send back subdirectories to the main thread.

    I decided to indulge in my new favorite vice : before getting down and dirty with C, write a high level Perl prototype to spot the potential bugs and hurdles and make the C code writing easier.
    Here it is :D
    I hope you enjoy reading it, it is by no mean a better mousetrap, just my take on an interesting problem under specific constraints.

    As usual, even if that last line makes this post improper for CUFP (at least for one person who told me so):
    If you see bad practices, things that can be made better, do post about them, no point in making mistakes if I dont learn from them :)

    Update: The teacher updated the requirements, making it a bit more fun, now I have to look for a string in any file named *.txt or if both string and filename specified find said file and look for target string inside it.

    Also I started using getopt::std to make option handling cleaner also the script now displays the permissions for each file/dir found. enjoy!

    After re reading the assignment I put in some more changes. I am almost through with the C implementation. The striking difference is the number of lines written: 500 to 205 in Perl. Here is the last version of the perl prototype:

Modules as configuration files
1 direct reply — Read more / Contribute
by Discipulus
on Oct 28, 2015 at 08:59
    Ok is not so cool nor elaborate but i find it useful..
    Nowadays i end writing programs with a lot of options and I'm happy using Getopts::Long to grab them all. During testing but even during normal usage of such programs I hate tought to have a long command line, spwaning two or more lines of my terminal screen. As happens with long arguments list given to the find program.

    Along many other faults, i tend to write programs with core only modules, and no modules for configuration files are in the core.

    Even if minimalist a configuration file can contain comments and indentation..

    The basic idea of Perl module come in the rescue. Infact a module can be conviently imported even before any program you wrote by simply adding -M as in perl -MModuleName program.pl and as long the module resides in the current directory, no other Perl's switches are needed.
    Even more: since @ARGV is global by nature, the module can modify @ARGV before Getopts::Long starts his wonderful work inside the main program.

    The results is a short module like this:
    use strict; use warnings; unshift @ARGV,$_ for reverse map {s/\s*#.*$|^\s*#.*$//; (split ' ',$_,2)} split /\n/, <<'EOCONF' --put here -your --list of arguments and #any #indented --comment #comments --too EOCONF ; print "@ARGV" unless caller; 1;
    Unshifting them let an option specified in the module to be overwritten by the same option in the command line. For example if the module contains --verbosity 3 you can call the program perl -MConfigDefault program.pl --verbosity 0 and have the right behaviour.
    Please note that split as the LIMIT specified, so in the above exapmle --list has as value of arguments and ie only two arguments are created for each line. This is the desired behaviour.
    The final result seems like:
    perl -MConfigDefault program.pl --verbosity 0
    The print "@ARGV" unless caller; is inspired by the Modulino idea: when the program is invoked as program he build up the list and also print them. This way the module can contains configuration also for non Perl programs and receive them via xargs.
    For example if you have a long find configuration in ConfFind.pm you can invoke find this way:
    perl ConfigFind.pm | xargs find
    i hope you'll find it useful

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
SDR Scanner(aka Threaded wxPerl Example)
No replies — Read more | Post response
by jmlynesjr
on Oct 19, 2015 at 22:01

    SDR Scanner(aka Threaded wxPerl Example)

    Background: The July 2015 issue of Nuts and Volts magazine had an article on using an inexpensive DVB-T(Digital Video Broadcast-Terrestrial-EU Standard) USB dongle along with a 24MHz upconverter as the basis for an HF and higher Software Defined Receiver(SDR). The software used in the article was SDR# an MS-Windows application. As I am an Ubuntu user, I looked for a similar Linux application. I found gqrx. While waiting on parts to build the upconverter, I installed gqrx-sdr from the Ubuntu Software Center. It ran and pulled in various signals from 24MHz up, but was unstable. Turns out this was a pretty old version and after uninstalling and then installing via sudo add-apt-repository ppa:gqrx/snapshots, a current stable version was found. The output of gqrx can be routed through pulseaudio to other software(like fldigi) that can decode various digital modes.

    gqrx has a Remote Control feature that can accept commands(a subset of the Amateur Radio Rigctrl protocol) over a Telnet connection and more digging turned up a perl script(gqrx-scan) that uses this interface, through Net::Telnet, to implement a scanner feature. gqrx-scan has many bells and whistles that I wouldn't ever use so I wrote a lite/crude version(lite.pl) that just scans from F1 to F2 repeatedly. For more flexibility(and practice) I decided to expand lite.pl into a wxPerl application(threadedgqrxLite.pl), mostly a bunch of text controls and sizers. A future enhancement might include one or more lists of frequencies of interest, i.e. local repeaters, satellites, etc.

    For a hands-on introduction to SDR, take a look at websdr.com, a world-wide collection of SDR servers.

    What resulted is also an example of a wxPerl GUI operating in parallel with Perl Threads. YMMV. TMTOWTDI.

    James

    There's never enough time to do it right, but always enough time to do it over...

Radoteur
1 direct reply — Read more / Contribute
by QuillMeantTen
on Oct 17, 2015 at 12:07

    Greetings fellow monks,
    Today I bring you a nice perl script that I wrote in class.
    It was in OOP class and I needed a prototype before I started the implementation in java so I chose my favourite language.
    After a first implementation I discovered some intriguing aspects of the following algorithm. Because I wanted to understand its implications I needed more data so I rewrote it again and again. This is quite an interesting algorithm indeed.

    The radoteur (as explained in the comments at the beginning of the code) is an algorithm developed by a french researcher. It will take a list of events and will cycle through it creating a new stream. A first event is selected and when it reoccurs the immediate event after that one is then selected. Here I use word list but you could do it on images using each pixel rgb value or anything that comes to ind.

    so here is the code, have fun, I tried it on /usr/share/dict/words as well as the rockyou.txt wordlist that you can find on kali linux, the results are most interesting. Some time real words appear from the mess, expressions even. I hope you will have as much fun playing with it as I had writing it.

    Cheers!

    P.S. If you see any improvements or corrections to my code, please do tell me so, I know its not an SOPW post, yet I want to improve so feel free to send some feedback my way, it won't go to /dev/null.

tree command
5 direct replies — Read more / Contribute
by Skeeve
on Oct 13, 2015 at 04:09

    I'm, every now and then, missing a "tree" command at places where I have to work.

    And every now and then I "reinvent the wheel".

    To put an end to this, I decided to present my current version here.

    I hope it's useful to others and maybe I'll get some constructive feedback?

    Update: Added AppleFritter's suggestion of hiding hidden files

    #!/bin/env perl use strict; use warnings; use Getopt::Long qw(:config no_ignore_case); use Pod::Usage; my ( $showall, # show hidden files $showfiles, # show also files $showlinks, # show also a symlink's target ); help() unless GetOptions( a => \$showall, l => \$showlinks, f => \$showfiles, 'h|help' => \&help, 'm|man' => \&man, ); sub help { pod2usage(-verbose=>1); } sub man { pod2usage(-verbose=>2); } my $indent = ' '; my $indir = '--'; foreach my $path (@ARGV ? @ARGV : '.') { print $path,"\n"; traverse($path, ''); } sub traverse { my ($path, $depth) = @_; # Open the directory opendir my $dh, $path or die "Couldn't read $path: $!\n"; # Get all directory content - leaving out files unless asked for my(@content) = grep { not /^\.\.?$/ and ( $showfiles or not -f "$path/$_" ) and ( $showall or /^[^.]/ ) } readdir $dh; closedir $dh; # How many eitems are in the directory? my $count= scalar @content; # Prepare the standard indent my $i= $depth . '|' . $indent; # Print all the elements foreach my $sub (@content) { my $p= "$path/$sub"; # Prepare the last indent $i= $depth . ' ' . $indent unless --$count; print $depth, ($count ? '|' : '\\'), $indir , $sub; # Is it a link? if ( -l $p ) { # Shall they be shown as such if ($showlinks) { print " -> ", readlink $p; } print "\n"; next; } print "\n"; # Done unless it's a directory next unless -d $p; traverse($p, $i); } return; } =head1 NAME tree - A script to show a "graphical" representation of a directory st +ructure =head1 SYNOPSIS tree [options] [path...] =head1 DESCRIPTION tree will show a "graphical" representation of a directory structure, +including all files (when B<-f> specified) and link targets (when B<-l> specifie +d). =head1 OPTIONS =over 4 =item B<-f> Show also files. =item B<-l> Shhow also link targets. =item B<-h> =item B<--help> show a short help page. =item B<-m> =item B<--man> Show the man-page. =back =head1 AUTHOR Skeeve of perlmonks.org (perlmonks DOT org DOT Skeeve at XoXy dot net) Including ideas of Apple Fritter, a fellow Perl monk =cut

    s$$([},&%#}/&/]+}%&{})*;#$&&s&&$^X.($'^"%]=\&(|?*{%
    +.+=%;.#_}\&"^"-+%*).}%:##%}={~=~:.")&e&&s""`$''`"e
Edit files automatically cross-platform, line-endings unknown
No replies — Read more | Post response
by stevieb
on Sep 30, 2015 at 16:56

    I had a need for a piece of my software to be platform independent when reading/writing files with any type of line endings. So, I'm sure there are better/more efficient ways to do this, but I couldn't find one and really wanted to better understand record separators, so I wrote File::Edit::Portable.

    This module will read in a file on any platform, save the existing record separators (line endings), and modify them to the local platforms endings for use. It'll return either a file handle or an array of the file contents.

    You can optionally then push back an array of contents, and the module will rewrite the file (or optionally a new one), using the line endings that were found while reading (or optionally a user supplied one). This means it'll open Unix files on Windows and rewrite the file with Unix endings, and vice-versa on Windows and Mac (the three I've tested).

    use warnings; use strict; use File::Edit::Portable; my $rw = File::Edit::Portable->new; my $recsep; $recsep = $rw->recsep('unix.txt'); print "unix file before write: $recsep\n"; $recsep = $rw->recsep('win.txt'); print "win file before write: $recsep\n"; my $ufh = $rw->read(file => 'unix.txt'); my @unix_contents = <$ufh>; close $ufh; $rw->write(contents => \@unix_contents); $recsep = $rw->recsep('unix.txt'); print "unix file after rewrite: $recsep\n"; my $wfh = $rw->read(file => 'win.txt'); my @win_contents = <$wfh>; close $wfh; $rw->write(contents => \@win_contents); $recsep = $rw->recsep('win.txt'); print "win file after rewrite: $recsep\n";

    Output:

    # unix $ ./find.pl unix file before write: \0a win file before write: \0d\0a unix file after rewrite: \0a win file after rewrite: \0d\0a # windows E:\test>perl find.pl unix file before write: \0a win file before write: \0d\0a unix file after rewrite: \0a win file after rewrite: \0d\0a

    We've also got a non-OO interface:

    use File::Edit::Portable qw(pread pwrite); my $fh = pread('file.txt'); # or even my @contents = pread('file.txt'); # then, later pwrite('file.txt', \@contents);

    I definitely know it's quite inefficient, but it's my first working prototype. There are a lot of things missing (unicode and open filters for instance). Criticisms or existing ways to do this are very welcome.

    -stevieb


Add your CUFP
Title:
CUFP:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others examining the Monastery: (8)
    As of 2016-02-09 21:52 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      How many photographs, souvenirs, artworks, trophies or other decorative objects are displayed in your home?





      Results (326 votes), past polls