Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
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
Finally! Perl code for the MCP3008 Analog to Digital Converters
No replies — Read more | Post response
by stevieb
on Mar 11, 2017 at 16:38

    I had issues a month ago trying to get this to work, so I left it knowing I'd come back to it. I had a one-off issue that was throwing me off. Now, RPi::ADC::MCP3008 is available.

    This SPI-connected device has a very handy feature I've incorporated. You can connect its CS pin to either of the two built-in hardware SPI Slave Select (CE aka CS) pins on the Pi and the Pi will handle the bridging of the communication, or, if those two pins are already in use, you can set the channel to an unused GPIO pin, connect that to the ICs CS pin, and we'll automagically bit-bang the SPI bus for you. Essentially, this trick allows you to connect as many ICs as you have GPIO, plus the two onboard hardware SPI bus pins.

    my $spi_channel = 0; my $adc = RPi::ADC::MCP3008->new($spi_channel); my $adc_channel = 0; # 0-7 single ended, 8-15 differential my $raw = $adc->raw($adc_channel); my $percent = $adc->percent($adc_channel); print "input value: $raw, $percent\n"; __END__ input value: 776, 78.49

    The above example uses pin CE0 on the RPi, which is the first of the two hardware SPI slave select channels. To use a GPIO pin instead and to free up the hardware SPI pins, use a GPIO pin number higher than 1, and connect that GPIO pin to the CS pin on the chip:

    my $chan = 26; # (GPIO pin 26) my $adc = RPi::ADC::MCP3008->new($chan); ...

    ...we'll do the bit-banging of the bus automatically, so you don't have to.

    The documentation includes the different ADC input channels and modes, a simplistic Rasperry Pi 3 breadboard layout, and a link to the datasheet if you're interested.

    I have expanded my RPi::SPI with this auto bit-banging trick, and didn't even have to change the API at all. 2.36.5 of that distribution includes the new feature, and should hit a CPAN mirror near you shortly.

    The trickery starts in the module, but the implementation and math is written in C, using calls to the base library. Feedback welcome on my C implementation.

AD&D worlds, recursive gameobjects
No replies — Read more | Post response
by holyghost
on Mar 09, 2017 at 01:59
    Back with some game programming : if you make a dungeons & dragons world you might want to put a room inside e.g. a bag of wonders, that room could already contain the same bag of wonders. Below is some code which morphs an Gameobject which is a dimension in a place in the world e.g. an Entity/MovingEntity becomes a EntityRec, a recursive entity. You only need an interrupt and a loop for checking whether there is recursion in the world. Note that it is perl6 :
    class PaganVision2::Entity is GameObject { has $!staticimagelib ### StateImagelibrary.pm6 method update(%keys, %keydefs) { } method draw($renderer) { $!staticimagelib.getImage().display($renderer); } } class PaganVision2::MovingEntity is GameObject { has $!direction; has $!moving; has $!dx; ### move x + dx has $!dy; has $!leftstaticimagelib ### StateImagelibrary.pm6 has $!righttstaticimagelib has $!upstaticimagelib has $!downstaticimagelib has $!leftimagelib has $!rightimagelib has $!upimagelib has $!downimagelib has $!currentlibrary; method update(%keys, %keydefs) { foreach $e in %keydefs.keys { if (not $e[0]) { ### UP $!currentlibrary = $upstaticimagelib; } elif (not $[1]) { ### DOWN $!currentlibrary = $downstaticimagelib +; } elif (not $e[2]) { ### LEFT $!currentlibrary = $leftstaticimagelib +; } elif (not $e[3]) { ### RIGHT $!currentlibrary = $rightstaticimageli +b; } } } method draw($renderer) { $!currentlibrary.getImage().display($renderer); } } ### Note that Room is a GameObject and that it can be put in e.g. a ba +g of wonders class PaganVision2::Room is GameObject { method BUILD() { ### Image $!bg_image .= new; } } ### This entity is recursive which means that ### it contains things that contain this entity ### If an Entity becomes recursive it ### morphs into EntityRec in the game engine class PaganVision2::EntityRec : is Entity { method update(%keys, %keydefs) { } method draw($renderer) { $!staticimagelib.getImage().display($renderer); } }
Lower-Level Serial Port Access on *NIX
1 direct reply — Read more / Contribute
by haukex
on Mar 01, 2017 at 10:07

    Dear Monks,

    Most likely, everyone who's needed to access a serial port on *NIX systems has used, or at least come across, Device::SerialPort. It's nice because it provides a decent level of portability, being designed to be a replacement for Win32::SerialPort. However, it's always bugged me a little bit that the module is a bit unwieldy, with a lot of configuration and functions I never use, several documented as being experimental, and that its filehandle interface is tied instead of native. So, I'd like to present an alternative that has been working well for me over the past months, IO::Termios. It's a subclass of IO::Handle, and the handles can be used directly in IO::Select loops, which can be used to implement nonblocking I/O and timeouts, or for example a POE POE::Wheel::ReadWrite, just to mention two possibilities. (Note: I'm not saying IO::Termios is "better" than Device::SerialPort, just that so far it has been a viable alternative.)

    Here's a basic example:

    use IO::Termios (); my $handle = IO::Termios->open('/tmp/fakepty', '4800,8,n,1') or die "IO::Termios->open: $!"; while (<$handle>) { # read the port line-by-line chomp; print time." <$_>\n"; # write something to the port print {$handle} "Three!\n" if /3/; } close $handle;

    An Aside: Fake Serial Ports on *NIX

    You may have noticed that in the above example, instead of the usual device names like e.g. /dev/ttyAMA*, /dev/ttyS*, or /dev/ttyUSB*, I used "/tmp/fakepty". I created this for testing using the versatile tool socat, here are two examples:

    # connect the fake pty to a process that generates output $ socat pty,raw,echo=0,link=/tmp/fakepty \ exec:'perl -e "$|=1;while(1){print q{Foo },$x++,qq{\n};sleep 2}"' # connect the fake pty to the current terminal $ socat pty,raw,echo=0,link=/tmp/fakepty -,icanon=0,min=1

    More Fine-Grained Control

    It's also possible to use sysopen for the ports, if you want to have control over the exact flags used to open the port. Also, if you need to set some stty modes, you can do so with IO::Stty. I've found that for several of the USB-to-Serial converters I've used that it's necessary to set the mode -echo for them to work correctly, and raw is necessary for binary data streams.

    use Fcntl qw/:DEFAULT/; use IO::Termios (); use IO::Stty (); sysopen my $fh, '/tmp/fakepty', O_RDWR or die "sysopen: $!"; my $handle = IO::Termios->new($fh) or die "IO::Termios->new: $!"; $handle->set_mode('4800,8,n,1'); IO::Stty::stty($handle, qw/ raw -echo /); my $tosend = "Hello, World!\n"; $handle->syswrite($tosend) == length($tosend) or die "syswrite"; for (1..3) { my $toread = 1; $handle->sysread(my $in, $toread) == $toread or die "sysread"; print "Read $_: <$in>\n"; } $handle->close;

    My error checking in the above example is a little simplistic, but I just wanted to demonstrate that using sysread and syswrite is possible like on any other handle.

    I've noticed that there is some interaction between IO::Termios and IO::Stty - for example, when I had to connect to a serial device using 7-bit and even parity, I hat to set the termios mode to 4800,7,e,1 and set the stty modes cs7 parenb -parodd raw -echo for things to work correctly.

    I have written a module that wraps an IO::Termios handle and provides read timeout, flexible readline, signal handling support, and a few other things. However, I need to point out that while I've been using the module successfully in several data loggers over the past few months in a research environment, it should not yet be considered production quality! The major reason is that it's not (yet?) a real CPAN distro, and it has zero tests! But if you're still curious, for example how I implemented a read timeout with IO::Select, you can find the code here.

    Update: Added mention of some /dev/* device names.

Fast gzip log reader with MCE
1 direct reply — Read more / Contribute
by marioroy
on Mar 01, 2017 at 05:54

    Greetings, fellow Monks.

    I came across an old thread. One might do the following to consume extra CPU cores. The pigz binary is useful and depending on the data, may run faster than gzip. The requirement may be to have each MCE worker process a single file inside the MCE loop. So we set chunk size accordingly (chunk_size => 1).

    To make this more interesting, workers send data to STDOUT and gather key-value pairs.

    use strict; use warnings; use feature qw(say); use MCE::Loop chunk_size => 1, max_workers => 4; my @files = glob '*.gz'; my %result = mce_loop { my ($mce, $chunk_ref, $chunk_id) = @_; ## $file = $_; same thing when chunk_size => 1 my $file = $chunk_ref->[0]; ## http://www.zlib.net/pigz/ ## For pigz, we want -p1 to run on one core only. ## open my $fh, '-|', 'pigz', '-dc', '-p1', $file or do { ... } open my $fh, '-|', 'gzip', '-dc', $file or do { warn "open error ($file): $!\n"; MCE->next(); }; my $count = 0; while ( my $line = <$fh> ) { $count++; # simulate filtering or processing } close $fh; ## Send output to the manager process. ## Ensures workers do not garble STDOUT. MCE->say("$file: $count lines"); ## Gather key-value pair. MCE->gather($file, $count); } @files; ## Workers may persist after running. Request workers to exit. MCE::Loop->finish(); ## Ditto, same output using gathered data. for my $file (@files) { say "$file: ", $result{$file}, " lines"; }

    Regards, Mario.

How much disk space would be freed?
1 direct reply — Read more / Contribute
by reisinge
on Feb 21, 2017 at 04:41

    Is your (Unix/Linux) filesystem getting full and you wonder whether removing some old log files would help? Use this one-liner to find out how much space would be freed:

    find /opt/app/logs -iname "*log*" -type f -mtime +30 | perl -lne '$sum + += (stat)[7] }{ print $sum'
    It's nice to be important, but it's more important to be nice. -- Tommy
Adding without Addition
1 direct reply — Read more / Contribute
by GotToBTru
on Feb 15, 2017 at 13:06

    Wasn't sure if this belongs here, or in Obfuscations.

    Having once run:

    use strict; use warnings; use Storable; my (%table); foreach my $i (0..9) { foreach my $j ($i..9) { $table{$i}{$j} = $table{$j}{$i} = $i + $j } } store \%table, 'addition_table';

    I present to you: addition!

    use strict; use warnings; use Storable; my %table = %{retrieve('addition_table')}; my @problem = @ARGV; my (%matrix); foreach my $number (@problem) { my $log = 0; push @{$matrix{$log++}}, $_ for reverse (split //, $number); } my $col = 0; while (exists $matrix{$col}) { my @column = @{$matrix{$col}}; my $first = shift @column; while(scalar @column > 0) { my $second = shift @column; $first = $table{$first}{$second}; if (length($first) > 1) { $first = substr($first,-1,1); push @{$matrix{$col + 1}}, 1; } } $matrix{$col++} = $first; } printf "%s",$matrix{$col - $_} for (1..$col); print "\n";
    H:\perl>perl adder.pl 1 1 H:\perl>perl adder.pl 21 14 99 6 12 152 H:\perl>perl adder.pl 999999999999999999999999999999999999999999 1 1000000000000000000000000000000000000000000

    Addition tables for other number systems are left as an exercise for the (extremely bored) reader. Vaguely apropos of Multiply Hex values. I started to write a program to do multiplication and realized I needed to figure out how to add first.

    But God demonstrates His own love toward us, in that while we were yet sinners, Christ died for us. Romans 5:8 (NASB)

Human-visible light levels - Adafruit Breakout board with I2C
1 direct reply — Read more / Contribute
by anita2R
on Feb 12, 2017 at 14:52

    AdaFruit sells a 'breakout' board for the dual-sensor TLS2561 Light-to-Digital Converter. The board provides i2c communicatiion and 3.3 or 5 volt operation.

    Adafruit provides software suitable for the Arduino and the sensor manufacturer provides some pseudo-code and code suitable for microprocessors. As a Raspberry Pi user I needed a Linux solution, so I have produced a short Perl script to obtain light levels in Lux, from the board.

    The TLS2561 uses 2 sensors, one of which only responds to infrared, so making it possible to get an approximation of human-visible light levels, by subtraction the infrared value from the infrared + visible value, (plus some mathematical manipulations).

    Before using the script, the user needs to replace <username> and <group> with their own username and group as the script must be called as root or using sudo, and once the i2c object is created the script falls back to the user's permissions.

    The script can be called 'as is' and default values will be used, or parameters can be passed which change the sensor sensitivity and the integration (sensing) time which affects the available range from the chip's two ADC's.

    The sensitivity -s parameter takes values of 0 or 1 (normal or x16 sensitivity).
    The integration -i parameter takes values of 0, 1 or 2 (13.7mS, 101mS or 402mS).
    If the script is called with the 'verbose' -v parameter on its own or with -s &/or -i, additional information is printed, including the raw sensor values.

    The math for doing the Lux calculations comes from the TLS2561 datasheet, which hopefully I have interpreted correctly! As I don't have a Lux meter, I can't be sure, but the results under different lighting conditions appear 'reasonable'.

    Script - readI2cLux.pl:

    Sample calls:
    Standard sensitivity and shortest sampling duration:
    sudo readI2cLux.pl -s 0 -i 0
    x16 sensitivity and longest sampling duration:
    sudo readI2cLux.pl -s 1 -i 2
    Use default or last applied settings and get some additional feedback
    sudo readI2cLux.pl -v

    Example output with -v
    sudo readI2cLux.pl -s 1 -i 1 -v

    Timing register (old): 00010010 Timing Register (new): 00010001 Delay: 115 mS Channel 0 raw value: 4514 Channel 1 raw value: 298 Saturation value: 37177 Channel 0 scaled value: 17944 Channel 1 scaled value: 1184 Ratio is: 0.066 ******************************** * Visible light level: 520 lux * ********************************

    The breakout board from AdaFruit also includes an interrupt pin, but I have not programmed for its use, and the pin does not need to be connected. Also the adjacent 3vo pin can be left disconnected - the supply goes to the Vin pin.

    Leaving the 'Addr' pin disconnected selects the default 0x39 device address on the i2c bus.

    Any suggestions for improvements in the code or the math would be welcome.

Github repo with plenty of module examples
2 direct replies — Read more / Contribute
by neilwatson
on Feb 10, 2017 at 09:37
english numbers to chinese numbers
3 direct replies — Read more / Contribute
by changlehu
on Feb 08, 2017 at 02:13
    # script_name: numbers_to_chinese
    # usage: perl number2_to_chinese.pl 30806 
    # result: 三万零八百零六
    
    my %cn_numbers=(
    	1=>"一",
    	2=>"二",
    	3=>"三",
    	4=>"四",
    	5=>"五",
    	6=>"六",
    	7=>"七",
    	8=>"八",
    	9=>"九",
    );
    my $number=shift;
    my $cn_number;
    if ($number>=10000){
    	my $n=$number/10000;
    	$n=~s/\..*//;
    	$cn_number=$cn_numbers{$n}."万";
    	$number=$number % 10000;
    }
    if ($number>=1000){
    	my $n=$number/1000;
    	$n=~s/\..*//;
    	$cn_number.=$cn_numbers{$n}."千";
    	$number=$number % 1000;
    }
    if ($number>=100){
    	my $n=$number/100;
    	$n=~s/\..*//;
    	$cn_number.=$cn_numbers{$n}."百";
    	$number=$number % 100;
    }
    if ($number>=10){
    	my $n=$number/10;
    	$n=~s/\..*//;
    	$cn_number.=$cn_numbers{$n}."十";
    	$number=$number % 10;
    }
    if ($number>0){
    	$cn_number.=$cn_numbers{$number};
    }
    #补零
    if ($cn_number=~/万/ && $cn_number!~/千/){
    	$cn_number=~s/万/万零/;
    }
    if ($cn_number=~/千/ && $cn_number!~/百/){
    	$cn_number=~s/千/千零/;
    }
    if ($cn_number=~/百/ && $cn_number!~/十/){
    	$cn_number=~s/百/百零/;
    }
    $cn_number=~s/一十/十/g;
    print "$cn_number\n";
    
    
Back up all of your Github repos
1 direct reply — Read more / Contribute
by stevieb
on Feb 03, 2017 at 14:34

    For my next adventure, I'm going to write a distribution that allows a user to easily back up all of their Github repos, issues, PRs, wikis etc, but since hearing about the near disaster at Gitlab, I thought I'd expedite writing this one.

    I've put together a quick script just so I could begin getting used to the various APIs I'd need, and am sharing it here in the event someone else finds it useful.

    Currently, it'll clone all repositories under the $user variable, and will skip over repos you've forked (ie. only your own true repos will be included). Remove the if (! exists $content->{parent}) check to also back up the repos you've forked.

    There's a blurb below the code for users who require a proxy. Also note that Github limits the number of API calls an unauthorized user can make, so you'll likely want to create a Github token.

    use warnings; use strict; use Data::Dumper; use Git::Repository; use File::Copy qw(move); use File::Path qw(rmtree); use Pithub; my $user = 'stevieb9'; my $token = '...'; my $bak = 'backups'; my $stg = 'backups.stg'; my $gh = Pithub->new( user => $user, token => $token ); my $result = $gh->repos->list(user => $user); my @repos; while (my $row = $result->next){ print "$row->{name}\n"; push @repos, $row->{name}; } # prepare the staging dir if (-d $stg){ rmtree $stg or die $!; mkdir $stg or die $!; } for (@repos){ my $content = $gh->repos() ->get(user => $user, repo => $_) ->content; if (! exists $content->{parent}){ print "backing up $content->{full_name}...\n"; Git::Repository->run( clone => $content->{clone_url} => "$stg/$content->{name}", { quiet => 1} ); } } # move staging into the backup dir if (-d $bak){ rmtree $bak or die $!; } move $stg, $bak or die $!;

    That'll create a backups.stg dir in your current working directory, clone all of your repos into it, then when done, moves the staging dir over top of a backups dir.

    If you are behind a proxy server, you'll need to add the following lines, and change your Pithub call to new():

    use LWP::UserAgent; my $ua = LWP::UserAgent->new; $ua->env_proxy; my $gh = Pithub->new( ua => $ua, # <-- add this user => $user, token => $token );

    Output:

    backing up stevieb9/app-envcontrol... backing up stevieb9/app-rpi-envui... backing up stevieb9/async-event-interval... backing up stevieb9/berrybrew... backing up stevieb9/bit-manip... backing up stevieb9/bit-manip-pp... backing up stevieb9/business-isp... backing up stevieb9/cgi-application-plugin-pagebuilder... backing up stevieb9/cisco-acl-count... backing up stevieb9/config... backing up stevieb9/csharp-template... backing up stevieb9/devel-examine-subs... backing up stevieb9/devel-trace-method... backing up stevieb9/devel-trace-subs... backing up stevieb9/dht11-env-control... backing up stevieb9/dnmfarrell-berrybrew... backing up stevieb9/file-edit-portable... backing up stevieb9/File-Portable... backing up stevieb9/freeradius-database... backing up stevieb9/github-backup... backing up stevieb9/mock-sub... backing up stevieb9/netstat-session-stats... backing up stevieb9/nginx-autoconfig... backing up stevieb9/p5-app-copyrightimage... backing up stevieb9/p5-brew-build-script... backing up stevieb9/p5-hook-output-tiny... backing up stevieb9/p5-logging-simple... backing up stevieb9/p5-net-ping... backing up stevieb9/p5-plugin-simple... backing up stevieb9/p5-rpi-dht11-envcontrol... backing up stevieb9/p5-rpi-wiringpi-constant... backing up stevieb9/p5-test-brewbuild-plugin-testagainst... backing up stevieb9/p5-test-brewbuild-revdeps... backing up stevieb9/patches... backing up stevieb9/perl6-log-simple... backing up stevieb9/rpi-adc-ads... backing up stevieb9/rpi-adc-ads_pp... backing up stevieb9/rpi-adc-mcp3008... backing up stevieb9/rpi-bmp180... backing up stevieb9/rpi-dac-mcp4922... backing up stevieb9/rpi-dht11... backing up stevieb9/rpi-digipot-mcp4xxxx... backing up stevieb9/rpi-hcsr04... backing up stevieb9/rpi-shiftreg-sn74hc595... backing up stevieb9/rpi-spi... backing up stevieb9/rpi-wiringpi... backing up stevieb9/scripts... backing up stevieb9/sftp-log-format... backing up stevieb9/sftp-user... backing up stevieb9/svn-repl-wrapper... backing up stevieb9/tcpdump-pcap-sort... backing up stevieb9/test-brewbuild... backing up stevieb9/test-fail... backing up stevieb9/wiringpi-api... backing up stevieb9/wrap-sub... backing up stevieb9/xen-conf-generate...

    update: s/anauthorized/unauthorized/

Pass a Perl aref to C, work on it, and get it back as a Perl array
2 direct replies — Read more / Contribute
by stevieb
on Jan 27, 2017 at 11:00

    ...and how to use the generated XS code in your own module.

    This is a tutorial as much as it is a request for guidance from experienced XS/C/perlguts folks, as TIMTOWTDI, and in this case, likely, a better way (like working on the array reference directly, which I've yet to figure out how).

    This will show you how to pass a Perl array reference (aref) into a C function, convert the aref into a C array, work on it, then push it back onto the stack so the C function returns it as a Perl array (actually a list, but I digress).

    It'll also show that although we bite off of Inline::C, the XS code it generates can be used in your distribution, even without the end-user needing Inline installed.

    First, straight to the code. Comments inline for what's happening (or, at least, what I think is happening... feedback welcomed):

    use warnings; use strict; use feature 'say'; use Inline 'Noclean'; use Inline 'C'; my $aref = [qw(1 2 3 4 5)]; # overwrite the existing aref to minimize memory # usage. Create a new array if you need the existing # one intact @$aref = aref_to_array($aref); say $_ for @$aref; __END__ __C__ void aref_to_array(SV* aref){ // check if the param is an array reference... // die() if not if (! SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV){ croak("not an aref\n"); } // convert the array reference into a Perl array AV* chars = (AV*)SvRV(aref); // allocate for a C array, with the same number of // elements the Perl array has unsigned char buf[av_len(chars)+1]; // convert the Perl array to a C array int i; for (i=0; i<sizeof(buf); i++){ SV** elem = av_fetch(chars, i, 0); buf[i] = (unsigned char)SvNV(*elem); } // prepare the stack inline_stack_vars; inline_stack_reset; int x; for (x=0; x<sizeof(buf); x++){ // extract elem, do stuff with it, // then push to stack char* elem = buf[x]; elem++; // the sv_2mortal() rectifies refcount issues, // and ensures there's no memory leak inline_stack_push(sv_2mortal(newSViv(elem))); } // done! inline_stack_done; }

    We now get an _Inline directory created within the current working directory, which has a build/ dir and then a sub directory (or multiple, just look at the one with the most recent timestamp). Peek in there, and you'll see a file with an .xs extention. This is the file you want if you want to include your work into a real Perl distribution. This essentially allows one to utilize my favourite feature of Inline::C, which is to build XS code for us, without having to know any XS (or little XS) at all.

    After I run the above example, I get this in the XS file (my comments removed):

    #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "INLINE.h" void aref_to_array(SV* aref){ if (! SvROK(aref) || SvTYPE(SvRV(aref)) != SVt_PVAV){ croak("not an aref\n"); } AV* chars = (AV*)SvRV(aref); unsigned char buf[av_len(chars)+1]; int i; for (i=0; i<sizeof(buf); i++){ SV** elem = av_fetch(chars, i, 0); buf[i] = (unsigned char)SvNV(*elem); } inline_stack_vars; inline_stack_reset; int x; for (x=0; x<sizeof(buf); x++){ char* elem = buf[x]; elem++; inline_stack_push(sv_2mortal(newSViv(elem))); } inline_stack_done; } MODULE = c_and_back_pl_f8ff PACKAGE = main PROTOTYPES: DISABLE void aref_to_array (aref) SV * aref PREINIT: I32* temp; PPCODE: temp = PL_markstack_ptr++; aref_to_array(aref); if (PL_markstack_ptr != temp) { /* truly void, because dXSARGS not invoked */ PL_markstack_ptr = temp; XSRETURN_EMPTY; /* return empty stack */ } /* must have used dXSARGS; list context implied */ return; /* assume stack size is correct */

    To note is the following line:

    MODULE = c_and_back_pl_f8ff PACKAGE = main

    That dictates the name of the module you're creating the XS for. You'll want to change it to something like:

    MODULE = My::Module PACKAGE = My::Module

    ...then put that file in the root of your distribution, and add, into your distribution's primary .pm module file:

    require XSLoader; XSLoader::load('My::Module', $VERSION);

    Normally, the #include INLINE.h can be removed, but because we're using some Inline functionality, we need to grab a copy of INLINE.h from somewhere and copy it into the root directory of our distribution so that everything compiles nicely. There's always a copy of it in the _Inline/build/* directory mentioned above. Providing this header file will allow users of your distribution that don't have Inline::C installed to use your module as if they did have it.

Raspberry Pi with analog inputs/outputs, driven by Perl
No replies — Read more | Post response
by stevieb
on Jan 25, 2017 at 23:01

    Well, all of the learning and testing I've done with C, XS, managing bits, reading and understanding hardware datatsheets etc in the last few months is really starting to pay off, with a lot of kudos going out to many Monks here for providing guidance and help with my questions.

    We now have reliable, working Perl code to output and receive input analog signals on the Raspberry Pi. This example uses an MCP41010 digital potentiometer for the analog out, and an ADC1015 analog to digital converter for analog in. I still have two different ADCs to write code for, two more models of digital pots, and later this week I should be receiving my DACs (digital to analog converter), my GPS receiver chip, and my MCP3004/8 ADCs.

    This doesn't do much, but it's the base of what will eventually allow me to have a Pi in the corner that all it does is pull from github and continuously (and automatically!) run unit tests for the Pi software. However, with true analog output/inputs, there's a lot more a Pi can do.

    The schematic and the breadboard layout for the setup.

    Note that the digital pot operates over the SPI bus, which uses RPi::SPI, which is the software I wrote that allows an aref to be sent into a C function (I haven't changed it to use one of the other methods yet) as discussed in this node. The fun aref part is here, in the base WiringPi::API.

    update: the SPI RW functionality now not only allows an aref to be sent in, but will very soon return a proper Perl array, so that you'll always get the read bytes back on every transaction, in the proper order and count. See here if you're interested in what I call Perl Awesomeness./update

    Code:

    use warnings; use strict; use RPi::WiringPi; my $pi = RPi::WiringPi->new; my $adc = $pi->adc; my $cs = $pi->pin(18); my $dpot = $pi->dpot($cs->num, 0); $dpot->set(0); print "\nValue, Output %\n\n"; for (0..255){ if (($_ % 10) != 0 && $_ != 255){ next; } $dpot->set($_); my $p = $adc->percent(0); print "$_/255: $p %\n"; select(undef, undef, undef, 0.3); } print "\n\nOutput % at 127/255\n\n"; $dpot->set(127); for (0..10){ print $adc->percent(0) . " %\n"; select(undef, undef, undef, 0.2); } $pi->cleanup;

    All it does is switch to different taps (resistor level) on the digital pot which increases/decreases output voltage. The ADC's input pin (A0) is connected directly to the output of the pot, as is the LED, just so I can see visually the changes as well as receive them digitally via the software.

    Output:

    Value, Output % 0/255: 0.36 % 10/255: 4.24 % 20/255: 8.12 % 30/255: 12.00 % 40/255: 15.88 % 50/255: 19.76 % 60/255: 23.70 % 70/255: 27.58 % 80/255: 31.45 % 90/255: 35.33 % 100/255: 39.21 % 110/255: 43.09 % 120/255: 46.97 % 130/255: 50.85 % 140/255: 54.79 % 150/255: 58.61 % 160/255: 62.48 % 170/255: 66.42 % 180/255: 70.24 % 190/255: 74.12 % 200/255: 77.70 % 210/255: 81.21 % 220/255: 84.91 % 230/255: 88.67 % 240/255: 92.67 % 250/255: 96.97 % 255/255: 99.21 % Output % at 127/255 49.70 % 49.70 % 49.70 % 49.70 % 49.70 % 49.70 % 49.70 % 49.70 % 49.76 % 49.76 % 49.70 %
Bit string manipulation made easy with Bit::Manip
3 direct replies — Read more / Contribute
by stevieb
on Jan 25, 2017 at 12:40

    I've been writing a lot of software lately that deals with direct hardware access (specifically analog and digital hardware for the Raspberry Pi). This means that I've had to learn some C, as well as get proficient with bit manipulation and the bitwise operators.

    As part of my learning, I thought I'd write a module to do this bit manipulation for me, hence Bit::Manip was born. (There's also a Bit::Manip::PP for those who can't/don't want to use XS. It should be indexed shortly).

    Here's a scenario based example of how the software can be used.

    You have a 16-bit configuration register for a piece of hardware that you want to configure and send in. Here's the bit configuration:

    |<--------- 16-bit config register ---------->| | | | |---------------------------------------------| | | | | | | |<------Byte 1: Control------>|<-Byte0: Data->| | | | |-----------------------------|---------------| | 15 | 14 13 | 12 11 | 10 9 8 | 7 6 5 4 3 2 1 | __ _____ _____ ______ _____________ ^ ^ ^ ^ ^ | | | | | START | | UNUSED DATA CHANNEL | PIN SELECT

    ...and the bit configuration:

    15: Start conversation 0 - do nothing 1 - start conversation 14-13: Channel selection 00 - channel 0 01 - channel 1 11 - both channels 12-11: Pin selection 00 - no pin 01 - pin 1 11 - pin 2 10-8: Unused (Don't care bits) 7-0: Data

    Let's start out with a 16-bit word, and set the start bit. Normally, we'd pass in an actual value as the first param ($data), but we'll just set bit 15 on 0 to get our initial data.

    my $data = bit_on(0, 15);

    A couple of helper functions to verify that we indeed have a 16-bit integer, and that the correct bit was set:

    say bit_count($data); say bit_bin($data);

    Output to ensure we're good:

    16 1000000000000000

    Now, we've got the conversation start bit set in our register, and we want to set the channel. Let's use both channels. For this, we need to set multiple bits at once. The datasheet says that the channel is at bits 14-13. Take the LSB (13), pass it along with the data to bit_set(), the number of bits we're intending to update (2) and as the last parameter, put the binary bit string that coincides with the option you want (0b11) for both channels):

    # setting channel $data = bit_set($data, 13, 2, 0b11); # result: 1110000000000000

    We'll use pin 1, and per the datasheet, that's 0b01 starting from bit 11 (again, we're setting 2 bits):

    # setting pin $data = bit_set($data, 11, 2, 0b01); # result: 1110100000000000

    The next two bits are unused, so we'll ignore them, and set the data. Let's use 186 as the data value (10111010 in binary). We're setting 8 bits here:

    # setting data $data = bit_set($data, 0, 8, 186); # or: bit_set($data, 0, 8, 0b10111010); # result: 1110100010111010

    Now we realize that we made a mistake above. We don't want both channels after all, we want to use only channel 1 (value: 0b01). Since we know exactly which bit we need to disable (14), we can just turn it off:

    $data = bit_off($data, 14); # result: 1010100010111010

    (You could also use bit_set() to reset the entire channel register bits (14-13) like we did above).

    Let's verify that we've got the register configured correctly before we send it to the hardware. We use bit_get() for this. The 2nd and 3rd parameters are MSB and LSB respectively, and in this case, we're only checking the 1-bit start bit, so MSB and LSB are the same:

    my $value = bit_get($data, 15, 15); say bit_bin($value); # result: 1

    So yep, our start bit is set. Let's verify the rest:

    # data # (note no LSB param. We're reading from bit 7 through to 0). # since we readily know the data value in decimal (186), we don't # need to worry about the binary representation say bit_get($data, 7); # result 186 # channel say bit_bin(bit_get($data, 14, 13)); # result 1 # pin select say bit_bin(bit_get($data, 12, 11)); # result 1 # ensure the unused bits weren't set say bit_get($data, 10, 8);

    So now we've set up all of our register bits, and confirmed it's ready to be sent to the hardware for processing.

    Perl has some handy features for making binary conversions very easy:

    # use a binary number directly: say 0b101; # 5 # format a number into a binary string, and print it printf("%b\n", 254); # 11111110 # convert a number to a binary string, and assign it my $bin = sprintf("%b", 127); # 1111111

    Disclaimer: also posted at blogs.perl.org.

    update: updated to reflect a bug fix talked about later in the replies./update

Reading from an HC-SR04 ultrasonic distance sensor on the Raspberry Pi
2 direct replies — Read more / Contribute
by stevieb
on Jan 13, 2017 at 17:38

    I've completed another Raspberry Pi related distribution, RPi::HCSR04. This one allows you to use Perl to read data from the HC-SR04 ultrasonic distance sensor.

    It's trivial to use, however, because it uses wiringPi internally, your scripts require root privileges.

    use warnings; use strict; use feature 'say'; use RPi::HCSR04; my $trig_pin = 23; my $echo_pin = 24; my $sensor = RPi::HCSR04->new($trig_pin, $echo_pin); # each call is a separate poll say $sensor->raw; say $sensor->cm . " cm"; say $sensor->inch . " \"";

    Output:

    634 10.915135593358 cm 4.29729747772217 "

    There's still a bit more work I have to do (catch out-of-range measurements etc), but it works pretty well and is surprisingly accurate.

    Note that per the documentation, the HC-SR04 requires 5v in, and also returns 5v from the ECHO pin back to the Pi's GPIO (which only handles 3.3v), so a voltage regulator or voltage divider is required to limit the voltage to a healthy 3.29v. I opted for the divider while writing the software. Here's a diagram depicting how I achieved that.

    Next up, a SN74HC595 shift register, as I need it to continue to work on the other various projects I have going on. I've almost completed the dist for the BMP180 barometric/altimeter sensor, as well as the MCP300x series analog-to-digital converters.

Perl interface to analog inputs on the Raspberry Pi
2 direct replies — Read more / Contribute
by stevieb
on Jan 11, 2017 at 11:16

    Over the last few months, I've been writing Perl modules/distributions to interact with a Raspberry Pi, its GPIO, and external hardware/devices. My primary objective is to create a complete indoor grow room automation system.

    The past week and a half, I have been focusing on writing a distribution that provides Perl users a way to interact with Adafruit's ADS1xxx Analog to Digital Converters (ADC), so that I could communicate with analog devices via the Pi which does not have any analog inputs. Hence, RPi::ADC::ADS was born.

    The vast majority of functionality specified in the unit's datasheet has been incorporated into this XS-based module, and the documentation outlays all of the critical pieces from the hardware docs.

    Features:

    • operates on the i2c bus, can connect four units simultaneously for a total of 16 analog inputs
    • ability to access all four channels on each ADC
    • continuous and single conversion modes
    • all eight Data Rate settings available
    • ability to change comparator polarity
    • ability to modify the comparator queue
    • all programmable gain amplifier modes available
    • ability to operate in single-ended mode or differential mode**
    • ability to return either the input data as raw, as a percentage, or as voltage
    • very easy to configure and run; most users won't have to set any parameters or call any configuration methods; the defaults are very sane
    • the documentation is extensive and detailed, but easy to understand and laid out reasonably well (I hope)
    • it has zero dependencies, Perl or otherwise (well, other than the need for a C compiler for the XS file)
    • works with any ADS1xxx model, and will properly bit-shift according to whether we're on a 16-bit wide resolution model, or a 12-bit one

    ** - single-ended mode is the measurement of voltage of a single input relative to ground. Differential mode retrieves the voltage difference between two separate inputs.

    Here's a basic example, and for the most part, exactly how I use the software. Say I have a moisture sensor connected to analog input A0 (0 as far as the software is concerned) and I want to get the moisture level from it:

    use warnings; use strict; use RPi::ADC::ADS; my $adc = RPi::ADC::ADS->new; my $v = $adc->volts; my $p = $adc->percent; my $r = $adc->raw;

    Volts is a floating point number, percent is a float chopped at .2f and raw is the raw 16-bit unsigned int.

    If you have more than one channel active at a time, specify which channel you want to fetch from:

    # A0, A1 and A3 input channels for (0, 1, 3){ print $adc->percent($_) ."\n"; }

    All configuration register options can be changed on the fly, as they each have their own setter/getter. Say you are using two inputs (eg: A0 and A3) as single-ended inputs and at one point in code, you need to retrieve the value of the difference in levels between them. The documentation has a map for parameter value to hardware functionality for all settings. All fetch methods allow you to send in the channel to retrieve on the fly, so we don't have to do anything special here. Per the map in the docs above, either of these will work:

    my $diff_a0_a3 = $adc->percent(5); # or $adc->channel(5); my $diff_a0_a3 = $adc->percent;

    The software is quite complete, and I have tested the vast majority of the configuration settings. I'm about 85% test coverage so there's a bit more work to do there, but I digress.

    My next project is to write a Perl distribution for a BMP 180 barometric and altimiter sensor which I just bought and soldered yesterday, and an MCP3008 analog-digital converter. The 3008 has 10 input channels whereby the ADS only has four, but the ADS has 12-bit or 16-bit of resolution accuracy, where the MCP3008 only has 10-bit, so I decided I'd write code for both.

    See also:

    WiringPi::API, my original and nearly feature complete wrapper for the WiringPi libraries.

    RPi::WiringPi, OO interface for the above wrapper with error detection, safe exit on unexpected terminations, and more.

    RPi::DHT11, module to access the DHT11 temperature and humidity sensor.

    App::RPi::EnvUI, my Dancer2 and jQuery one-page app for indoor grow room control (not yet fully completed).

    RPi::WiringPi::Constant, module that contains commonly used names in the Raspberry Pi/electrical/electronics realm.


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 all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others taking refuge in the Monastery: (5)
    As of 2017-06-24 04:00 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      How many monitors do you use while coding?















      Results (556 votes). Check out past polls.