Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
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
3D printing with out slicers and safety nets
No replies — Read more | Post response
by cavac
on Jun 09, 2021 at 12:21

    As some of you might know, i'm running a simulated space agency for fun and non-profit.

    A couple of years ago i came across something called crushable aluminium honeycomb for things like one-time-use super lightweight shock absorbers. ESA also has some version of special aluminium foam for the same purpose. Those super rich engineering departments over at ESA and NASA really have all the coolest toys, though.

    I don't have the metal working tools to replicate that (or a furnace or blocks of aluminium, for that matter). But i do have a couple of 3D printers and i know Perl. That's pretty much the same thing, isn't it?

    Looking at the requirements of how a 3D printed crushable PLA structure could work, it was pretty clear from the start that using a modeling program like OpenSCAD and a slicer software wouldn't work. My plan is to print a hard structure filled with lots of very thin PLA strands that would break under load, therefore absorbing energy. The slicer would either print those strand too thick or would remove them entirely.

    The only option i could see that would generate the results i want was to generate the printer commands myself. After a lot of on-and-off tinkering, i still don't have a working crushable structure, but i decided to post my printer test code now, so you all have a chance to play around with it if you want.

    A word of warning! The code is printer specific (i'm using a modified Creality Ender 5 Pro), so you will have to adapt at least some settings. Most 3D printers are also very dumb and will try to do whatever you tell them to do - most times "no matter what the consequences are". If you tell your printer "move the head 10 meters to the left and then set the extruder temperature to the surface temperature of the sun" it will happily crash the head and then try to burn your house down. I've named my codebase "Project Arcturus", if you are a Stargate Atlantis fan, you'll know why ;-)

    This code will generate my default "test object". Let's dive into it.

    perl -e 'use Crypt::Digest::SHA256 qw[sha256_hex]; print substr(sha256_hex("the Answer To Life, The Universe And Everything"), 6, 2), "\n";'
Compiling and uploading a crontab to my Radioduino
2 direct replies — Read more / Contribute
by cavac
on May 28, 2021 at 04:15

    For background information: I'm working on my Radioduino, a souped up version of an Arduino Uno with lots of inbuild features like a real-time clock and external memory etc. It communicates via nRF24 radio with my nRF24 "modem", which in turn is accessible via Net::Clacks in my local network.

    One of the features is a scheduler, similar to a Linux/Unix crontab. This is stored in FRAM in binary form and basically injects uplink radio commands at specified times into the command sequencer.

    The structure of the crontab in the Radioduino is this:

    typedef struct { uint8_t mode; uint8_t hour; uint8_t minute; uint8_t second; uint16_t offset; uint8_t command; uint8_t datalength; uint8_t data[16]; } SCHEDULEENTRY;

    Of course, this is binary and a pain in the seating arrangement to edit by hand. So i made some perl tools to compile plain ASCII text files and upload them.

    I hope this post isn't too boring and helps inspire some ideas for your own projects.

    perl -e 'use Crypt::Digest::SHA256 qw[sha256_hex]; print substr(sha256_hex("the Answer To Life, The Universe And Everything"), 6, 2), "\n";'
Stylish Tk clock -- oneliner
2 direct replies — Read more / Contribute
by Discipulus
on May 12, 2021 at 08:28
    ..I'm sorry.. I couldn't resist :)

    perl -MTk -e "$w=tkinit;$w->optionAdd('*font','Courier 20 bold');$w->L +abel(-textvariable=>\$n,-background=>'lavender')->pack;$w->repeat(100 +,sub{$n=scalar localtime time});MainLoop"

    L*

    PS minimalistic version

    perl -MTk -e "$w=tkinit;$w->geometry('400x1');$w->repeat(100,sub{$w->configure(-title=>scalar localtime time)});MainLoop"

    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.
boilerplate - solution
1 direct reply — Read more / Contribute
by plvicente
on May 11, 2021 at 06:29

    Hello Perl Monks. I found a solution for the last posts and for my new boilerplate perl issue and solution. I am coding two html default pages.
    Every page has similarities but one can list and search, the other can login or be registered.

    So, I will post a small solution code that i used for my server.

    I hope that I can help here too. I am a learner as all here. This was a solution that I seek and found easily to my problem. Build a good website template boilerplate for my company. Thank you all.

Align given substring(s) in lines
3 direct replies — Read more / Contribute
by johnaj
on Apr 28, 2021 at 14:55

    I chose not to use strict for this one, and it was actually kind of nice for a simple script like this one. Especially the autovivification. Note that the script doesn't work too well if the alignment points you specify don't appear in the same order as you specify them. The script could also be optimized by getting rid of the separate first pass.

    #!/usr/bin/perl -w # align -- align given substrings in standard input lines use Getopt::Std; $Getopt::Std::STANDARD_HELP_VERSION = 1; getopts('a', \%opt); sub VERSION_MESSAGE {} sub HELP_MESSAGE { print <<OPT; usage: $0 [-s] [string ...] -a add an extra space before split You should put the strings in the order that they occur in each line. Note that only the last string is guaranteed to align. OPT } @splits = @ARGV; # alignment points @splits = (' #') if not @splits; # default (Perl comment) while (<STDIN>) { chomp; push @lines, $_; } for $split (@splits) { $max = 0; # Find max column for split string for (@lines) { if (/(.+?)(\Q$split\E)(.*)/) { $max = length $1 if length $1 > $max; $_ = [$1, "$2$3"]; } } # Add one extra space before split $max++ if $opt{a}; # Add spaces before split for (@lines) { $_ = sprintf("%-${max}s%s", $_->[0], $_->[1]) if ref; } } print "$_\n" for @lines;

    Here is an example of how to use the script from the UNIX shell:

    $ cat example my $string = 'some value'; # these my $int = 12; # are my $float = 1.2; # scalars $ cat example | ./align = \# my $string = 'some value'; # these my $int = 12; # are my $float = 1.2; # scalars

    I personally use it to great effect in vi, so that I can type !}align to align the comments in the next block of code.

Creating X BitMap (XBM) images with directional gradients
1 direct reply — Read more / Contribute
by kcott
on Apr 02, 2021 at 04:34

    G'day All,

    I'm continuing my project to create interactive maps for RPGs with Tk generally and, for the main part, Tk::Canvas. I wrote a bit about that in "Tk::Canvas createGroup() Undocumented"; this CUFP post has nothing to do with the issue in that SoPW post; there is some backgound information and (very early, now substantially matured) code which may be of interest. The test code there to create creeks is related to the current work creating paths.

    I had created the basic paths, put nicely curved bends in them, and so on. All of this looked good except for where the paths terminated upon entering a glade, meadow, or whatever: all I had at the ends was solid lines; what I wanted was for these to gradually peter out. The sections for this needed to be solid (opaque) where the main path ended and gradually fade to nothingness (transparent) as the terrain moved away from the path. In addition, this gradient needed to have direction to match the direction of the path where it terminated.

    I made one futile attempt to do this manually in Gimp: the result looked horrible. I decided to let Perl do it for me. Here's the result which I knocked up this afternoon.

    — Ken

Modifying Image EXIF
No replies — Read more | Post response
by johngg
on Mar 24, 2021 at 12:23

    I was on the point of posting this anyway but BernieC's question makes it quite timely to do so now.

    I recently dug an old DSLR camera out of a cupboard to take some pictures, just to give it an outing really as I have newer cameras. Unfortunately I didn't notice that the camera had lost its date settings and had gone back to its epoch of January 1st, 2010. Not only were the dates wrong but also the filenames as the month and day is included in those, 1 .. 9, A .. C for the month then day number in offsets 1 through 3. The camera is usually configured to take only RAW files but sometimes I save both RAW and JPEG files so I had to cater for both. Luckily I knew the dates the camera had been used so I could modify filenames and EXIF dates but I also wanted the timestamps to have a sane time so I added a routine to increment the time from a starting point a random number of seconds for each successive photo. Here's the script:-

    use strict; use warnings; use Time::Piece; use Image::ExifTool qw{ :Public }; use feature qw{ say }; my $baseDir = q{/Path/To/Images/}; my @dirsToCorrect = ( { dir => q{20201206_JimBirthday/}, dateCode => q{C06}, dateStr => q{2020:12:06 17:49:11}, }, { dir => q{20210224_Garden/}, dateCode => q{224}, dateStr => q{2021:02:24 11:17:23}, }, ); foreach my $rhDir ( @dirsToCorrect ) { my $imgDir = $baseDir . $rhDir->{ dir }; my $dateSeq = makeDateSeq( $rhDir->{ dateStr } ); opendir my $imgDH, $imgDir or die qq{opendir: $imgDir: $!\n}; my @rawFiles = grep m{\.ORF$}, readdir $imgDH; closedir $imgDH or die qq{closedir: $imgDir: $!\n}; foreach my $rawFile ( @rawFiles ) { say qq{Processing $rawFile ...}; my $origPath = $imgDir . $rawFile; my $newRawFile = $rawFile; substr $newRawFile, 1, 3, $rhDir->{ dateCode }; my $newPath = $imgDir . $newRawFile; my $correctedDate = $dateSeq->(); my $exifTool = Image::ExifTool->new(); $exifTool->SetNewValue( q{CreateDate}, $correctedDate ); $exifTool->SetNewValue( q{DateTimeOriginal}, $correctedDate ); $exifTool->SetNewValue( q{FileName} => $newRawFile, Protected +=> 1 ); writeNewExif( $exifTool, $origPath, $newPath ); ( my $possJPGfile = $rawFile ) =~ s{ORF$}{JPG}; my $possJPGpath = $imgDir . $possJPGfile; next unless -e $possJPGpath; say qq{ ... and associated $possJPGfile ...}; my $newJPGfile = $possJPGfile; substr $newJPGfile, 1, 3, $rhDir->{ dateCode }; my $newJPGpath = $imgDir . $newJPGfile; $exifTool->SetNewValue( q{FileName} => $newJPGfile, Protected +=> 1 ); writeNewExif( $exifTool, $possJPGpath, $newJPGpath ); } } sub makeDateSeq { my $dateStr = shift; my $dateVal = Time::Piece->strptime( $dateStr, q{%Y:%m:%d %H:%M:%S +} ); return sub { $dateVal += ( int rand 75 ) + 10; return $dateVal->strftime( q{%Y:%m:%d %H:%M:%S} ); }; } sub writeNewExif { my( $exifTool, $origPath, $newPath ) = @_; print q{ } x 10, qq{writing $newPath ... }; my $success = $exifTool->WriteInfo( $origPath, $newPath ); if ( ! $success ) { say q{FAILED - }, $exifTool->GetValue( q{Error} ); } elsif ( $success == 1 ) { say q{OK, wrote changes}; print q{ } x 10, qq{removing $origPath ... }; say unlink( $origPath ) ? q{OK} : qq{FAILED - $!}; } else { say q{FAILED, wrote unchanged}; print q{ } x 10, qq{removing $newPath ... }; say unlink( $newPath ) ? q{OK} : qq{FAILED - $!}; } }

    Here's another script that pulls the EXIF out of files supplied as arguments and Data::Dumper->Dumpxs()'s the results. The files from my cameras include an embedded thumbnail image which I exclude from the dump as it just messes up the output.

    use strict; use warnings; use Image::ExifTool qw{ :Public }; use Data::Dumper; my %exif; while ( my $file = shift ) { do { warn qq{$file does not exist\n}; next; } unless -e $file; $exif{ $file } = ImageInfo( $file ); delete $exif{ $file }->{ ThumbnailImage }; } print Data::Dumper ->new( [ \ %exif ], [ qw{ *exif } ] ) ->Sortkeys( 1 ) ->Indent( 1 ) ->Dumpxs();

    I hope this is useful.

    Update: Note that the Image::ExifTool documentation states that the WriteInfo() method will accept a single filename argument in which case it will overwrite the original file with the new EXIF information included. It does encourage the user to make sure to have backups!

    Cheers,

    JohnGG

Tk and GD to custom rotate, resize and crop jpg images
No replies — Read more | Post response
by Discipulus
on Mar 15, 2021 at 11:57
    Hello folks!

    Tk and GD again. Imagine to have a lot of pictures of the same subject, let say historical Kawasaki motorcycles, but where this subject is off center, sometimes bigger sometimes smaller, other times the picture is rotated and you want to have them with the subject of the same size, always horizontal and all pictures centered. Dreadful hours of photo editing or.. tk-jepg-custom-rotator! :)

    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.
A Random Fortune Cookie
4 direct replies — Read more / Contribute
by choroba
on Mar 10, 2021 at 04:03
    I follow the #perl hashtag on Mastodon. Few days ago, someone asked:

    > Trying to randomize entries in a fortune text file. Not the output--the text of the human-readable fortune file. "sort -R" works on individual lines, but I want to grab multiline entries delimited by %.

    To which someone else replied

    > I figured it would be a two step solution. Step 1: install perl.

    Another person reacted with

    > <3 #perl. If you'd use a Perl one-liner let me know, I'll see if I can get one working. :)

    The hashtag in this reply was why I was informed about the discussion.

    Here's a sample from a typical fortune file (from ruanyf/fortunes):

    You cannot achieve the impossible without attempting the absurd. % Assumption is the mother of all screw-ups. % Thinking you know something is a sure way to blind yourself. % Neckties strangle clear thinking. % The first principle is that you must not fool yourself -- and you are +the easiest person to fool. -- Richard Feynman % The greater danger for most of us lies not in setting our aim too high + and falling short; but in setting our aim too low, and achieving our + mark. -- Michelangelo % I would rather have a mind opened by wonder than one closed by belief. -- Gerry Spence % What you are is what you have been. What you'll be is what you do now. -- Buddha % What we see is mainly what we look for. %

    And here's my solution:

    perl -0x25 -MList::Util=shuffle -e 'print +(shuffle<>)[0]'

    Update: As noted by hippo, the original request was more probably just to randomly sort the whole file. To do that, just remove the [0].

    Update 2: Unfortunately, there's the trailing empty cookie problem.

    perl -0x25 -MList::Util=shuffle -e '@f=<>;pop@f;print shuffle@f'

    map{substr$_->[0],$_->[1]||0,1}[\*||{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^*ARGV,3]
Simple CLI calculator based on Perl's eval()
6 direct replies — Read more / Contribute
by reisinge
on Mar 03, 2021 at 12:27

    Sometimes I need to do a quick calculation. I'm too lazy to open a GUI calculator and I never remember whether it's bc or dc (not mentioning the syntax). So I placed this code into ~/bin/calc:

    #!/usr/bin/perl -sT use strict; use warnings; use bignum; # Command line options... our ($h, $b, $x, $c, $l); # Help message... if ($h) { print <<'EOF'; Simple CLI calculator based on Perl's eval() calc [options] <expression> -h help -b convert expression (or its result) to binary -x convert expression (or its result) to hexadecimal -c convert expression (or its result) to character -l calculate base 2 logarithm of expression calc 149,600,000/299 792 458*1000/60 # comma or space are thousands + separator calc 2x2 + 2*2 # x is the same as * (multipli +cation) calc 'sqrt(V(3+3+3) * 3)' # V is the same as sqrt (squar +e root) calc -b 2^8 # ^ is the same as ** (exponen +tiation) calc -x $RANDOM calc -c 2**17-3030 calc -l 256 EOF exit 0; } # Allowed input characters regex... my $allowed = qr'\d\+\-\/\*\.x(sqrt)V'; # Transform input a bit... @ARGV = ( "@ARGV" =~ /[$allowed]/g ); # un-taint my $expr = "@ARGV"; $expr =~ s/\s+//g; # allow whitespace in input $expr =~ s/x/*/gi; # allow x for multiplication $expr =~ s/\^/**/g; # allow ^ for exponentiation $expr =~ s/V/sqrt/g; # allow V for square root $expr =~ s/sqrt/sqrt /g; # Do the calculation... my $res = eval "$expr"; die "Does not compute...$expr\n" unless defined $res; if ($b) { # Show result in binary... printf "%s = %b\n", $expr, $res; exit } elsif ($x) { # Show result in hex... printf "%s = %x\n", $expr, $res; exit } elsif ($c) { # Show result as character... binmode(STDOUT, ':utf8'); printf "%s = %c\n", $expr, $res; exit } if ($l) { # Calculate base 2 logarithm... $res = log($res)/log(2.0); } # Show thousands in result but not in the decimal part... my ( $before_dot, $after_dot ) = split /\./, $res; $before_dot =~ s/(\d{1,3}?)(?=(\d{3})+$)/$1 /g; printf "%s = %s.%s\n", $expr, $before_dot, $after_dot // 0;
    Solve the biggest problem you can. -- Nick Hanauer
Finding old copies of files
2 direct replies — Read more / Contribute
by Leitz
on Feb 24, 2021 at 05:35

    I write science-fiction for teens, and sometimes have to save documents into a non-text format. Not really an issue, but I like to make backups, and backups of my backups, because I've lost work before. I thought I had a slight problem, maybe a dozen or so files with five or six copies. No worries! I could save them as text, put them into version control, and then get rid of the old files. Life is good.

    The first pass at code said I had 21 files and 167 copies. Not good, but doable. Then I looked at the directory list and saw a lot of directories that should be searched were missing from the list. Going back to the code, I realized that there wasn't anything to recurse into a directory to see if there were more directories to be searched. Fixed that. Proud of myself, I ran the code again:

    With 161 unique files, there are 7621 copies.

    Oh boy...maybe I have a problem...

    The code below is a work in progress. I'm setting it up so that I can exclude the version controlled originals. Future steps include removing duplicate files and empty directories. Feedback is welcome! Code Repo

    #!/usr/bin/env perl # name: find_copies.pl # version: 0.0.2 # date: 20210223 # desc: Tool to help clean up old versions of files. ## TODO use strict; use warnings; use File::Basename; use Data::Dumper; use Getopt::Long; my %known_dirs; my %known_files; my @dir_queue; # Used to see how many copies we have. my $total_file_count = 0; my $actual_file_count = 0; my $log = 0; # set to 1 with the --log option. my $exclude_list_file; my %exclude_list; my $exclude_dir_file; my %exclude_dir; my $seed_file; # This is just a seed file, the results of 'locate +<filename>' sub usage { print "Usage: find_copies.pl --file <path/seed_file> [ --log | --exc +lude_list <file of files to not deal with> ] \n"; exit; }; # Pretty sure these could be made into one method. sub build_exclude_dir { open my $exclude_dirs, '<', $exclude_dir_file or die "Can't open $ex +clude_dir_file: $!"; for my $dir ( <$exclude_dirs> ) { chomp $dir; if ( -d $dir ) { $exclude_dir{$dir} = 1; } } close $exclude_dirs; } sub build_exclude_list { open my $exclude_files, '<', $exclude_list_file or die "Can't open $ +exclude_list_file: $!"; for my $file ( <$exclude_files> ) { chomp $file; $exclude_list{$file} = 1; } close $exclude_files; } sub build_file_list { foreach my $search_dir ( @dir_queue ) { opendir( my $dir, $search_dir ) or die "Can't open $search_dir: $! +"; foreach my $file ( readdir($dir)) { next if $file =~ m/^\.\.?$/; if ( -d "$search_dir/$file" ) { next if ( defined ($exclude_dir{"$search_dir/$file"}) ); $known_dirs{"$search_dir/$file"} = 1; push ( @dir_queue, "$search_dir/$file"); } else { next if ( defined( $exclude_list{$file} )); $total_file_count++; my $size = -s "$search_dir/$file"; $known_files{$file}{$size} = 1; } } closedir($dir); } } sub show_log { print Dumper(%known_files); $actual_file_count = scalar(keys(%known_files)); print "With $actual_file_count unique files, there are $total_file_c +ount copies.\n"; my @single_version_files; my @multiple_version_files; foreach my $file ( keys( %known_files ) ){ my @values = keys(%{$known_files{$file}}); if ( scalar(@values) > 1 ) { push @multiple_version_files, $file; } else { push @single_version_files, $file; } } @multiple_version_files = sort(@multiple_version_files); @single_version_files = sort(@single_version_files); if ( scalar( @multiple_version_files ) ) { print "Files with multiple versions:\n"; foreach my $f ( @multiple_version_files ) { print "\t $f \n"; } } if ( scalar( @single_version_files ) ){ print "Files with a single version:\n"; foreach my $f ( @single_version_files ) { print "\t $f \n"; } } if ( keys(%exclude_dir) ){ print "excluded directories:\n"; foreach my $dir ( keys(%exclude_dir) ){ print "\t $dir\n"; } } if ( keys( %exclude_list ) ) { print "excluded files:\n"; foreach my $file ( keys( %exclude_list ) ){ print "\t $file\n"; } } if ( keys(%known_dirs) ) { print "directory search list:\n"; foreach my $dir ( keys( %known_dirs )) { print "\t $dir\n"; } } } GetOptions( "--log" => \$log, "--file=s" => \$seed_file, "--exclude_files=s" => \$exclude_list_file, "--exclude_dirs=s" => \$exclude_dir_file, ); usage() unless ( defined($seed_file) ); open my $seed_data_file, '<', $seed_file or die "Can't open $seed_file +: $!"; build_exclude_list() if $exclude_list_file; build_exclude_dir() if $exclude_dir_file; # Build the list of directories to search. for my $line ( <$seed_data_file>) { chomp $line; my $dirname = dirname($line); $known_dirs{$dirname} = 1 unless defined( $exclude_dir{$dirname} ); push( @dir_queue, $dirname); } close $seed_data_file; build_file_list(); show_log() if $log;

    Chronicler: The Domici War (domiciwar.net)

    General Ne'er-do-well (github.com/LeamHall)

Calculating resistor pairs to generate a range of voltages
2 direct replies — Read more / Contribute
by GrandFather
on Feb 15, 2021 at 20:11

    I needed to generate resistor pairings for a resistor voltage divider to generate voltages from 0 to full scale in 256 steps for use with configuration on a PCB. The following script parses a CSV file dumped out from component supplier DigiKey and from the over 500 resistor values selects 58 that can be used to generate the 254 pairings needed (255 and 0 are special cases that aren't included).

    Prints:

    58 values used excluding 0 Ohm and 'DNF' 301: ERJ-PB3B3010V 340: ERJ-PB3B3400V ... 90900: ERJ-PB3B9092V 95300: ERJ-PB3B9532V 1: R1 90900, R2 357 = 1.00 (err 0.002: 1.00 - 1.00 = 0.00), +z = 356 2: R1 95300, R2 750 = 1.99 (err 0.009: 1.99 - 2.00 = 0.01), +z = 744 3: R1 49900, R2 590 = 2.98 (err 0.020: 2.97 - 2.99 = 0.01), +z = 583 4: R1 80600, R2 1270 = 3.96 (err 0.044: 3.95 - 3.96 = 0.02), +z = 1250 5: R1 80600, R2 1620 = 5.02 (err 0.024: 5.01 - 5.03 = 0.02), +z = 1588 ... 253: R1 340, R2 43200 = 253.01 (err 0.009: 253.00 - 253.01 = 0.01), +z = 337 254: R1 357, R2 90900 = 254.00 (err 0.002: 254.00 - 254.00 = 0.00), +z = 356 Max Z: 36437, min R: 602

    The report shows the actual values generated with ideal resistors and the range of values taking resistor tolerances into account. The z value is the effective impedance the ADC input sees. min R is the minimum series resistance of any resistor pair which relates to the maximum current through the resistors.

    Optimising for fewest key strokes only makes sense transmitting to Pluto or beyond
POE::Filter for Tor control protocol
No replies — Read more | Post response
by jcb
on Feb 12, 2021 at 22:24

    This is a rough draft of a module I intend to submit to CPAN soon, posted here for review and comments from the community.

    This is an early step towards using POE and Tk to write a Tor controller for my own use. The controller itself may or may not ever be worth publishing; it is an "excuse to learn POE" project for me, so it will probably be a bit of a mess.

    The interface is still in development; this "version 0.001" might not be the same code that is eventually uploaded to CPAN and the interface might change in later versions.

    lib/POE/Filter/Tor/TC1.pm:

    I note with some amusement that the test file is longer than the module itself. :-)

    t/POE-Filter-Tor-TC1.t:

Quick script to check data logger data
1 direct reply — Read more / Contribute
by GrandFather
on Feb 10, 2021 at 04:54

    The coolness factor in this script is more to do with the utility of Perl for whipping up a tool than very much that is special in the script. That said, the script does demonstrate why Perl is a great "whip it up language".

    The back story is that the astronomical society I'm a member of hosts a number of space weather related data collection systems at our dark sky site. The systems belong to researchers in Japan and the instruments we operate are part of an international network of similar instruments. About a year ago we added an induction magnetometer to the collection of instruments. Unfortunately it has been nothing but trouble. Over the period of a year we got about three days of data off it. Long story short - there was a hardware fault with the data logger. I've fixed that and now we are starting to collect data so I needed a way to check that the data is sensible. Enter Perl.

    As it happens the file format for the data is documented - as a C++ header containing a couple of C++ structs. That's OK. Perl is quite happy to read fixed size chunks from files then convert the chunks using unpack. Turned out that for the current task I needn't have bothered, but I'll use that code for another task in the future anyway. The data itself is kinda meaningless. It becomes interesting when passed through a FFT (Fast Fourier Transform). Hey, what do ya know, CPAN has a FFT module (several actually). And the data from an FFT is kinda unintelligible without plotting it - Tk, please step up.

    So the following (abridged) script is the result of a couple of hours work and lets me drag and drop files off the data logger onto a shortcut and make a visual check that the data looks sane.

    use strict; use warnings; use Math::FFT; use Tk; use Tk::Canvas; package ATSComments80_s; sub new { my ($class, $fileHandle) = @_; my $self = bless {fh => $fileHandle}, $class; $self->load(); return $self; } sub load { my ($self) = @_; read $self->{fh}, $self->{achClient}, 16; read $self->{fh}, $self->{achContractor}, 16; read $self->{fh}, $self->{achArea}, 16; read $self->{fh}, $self->{achSurveyID}, 16; read $self->{fh}, $self->{achOperator}, 16; read $self->{fh}, $self->{achReserved}, 112; read $self->{fh}, $self->{achXmlHeader}, 64; read $self->{fh}, $self->{achComments}, 512; } package ATSHeader80_s; sub new { my ($class, $fileHandle) = @_; my $self = bless {fh => $fileHandle}, $class; $self->load(); return $self; } sub load { my ($self) = @_; read $self->{fh}, $self->{siHeaderLength}, 2; $self->{siHeaderLength} = unpack 's<', $self->{siHeaderLength}; ...; read $self->{fh}, $self->{abyADBBoardType}, 4; $self->{tscComment} = ATSComments80_s->new($self->{fh}); } package main; my $filePath = $ARGV[0] // "testData.ats"; open my $fh, '<:raw', $filePath or die "Can't open $filePath: $!"; my $header = ATSHeader80_s->new($fh); my $itemCount = 0; my @data; while ($itemCount++ < 1024 && read $fh, my ($value), 4) { $value = unpack 'l<', $value; push @data, $value; } my $fft = Math::FFT->new(\@data); my $mw = MainWindow->new (-title => "Magnetometer Plotter"); my $canvas = $mw->Canvas (-height => 700, -width => 1024)->pack (); my $spectrum = $fft->spctrm; # Remove DC signal component shift @$spectrum; $spectrum = NormData($spectrum, 680); $canvas->createLine( (map {2 + 2 * $_, $spectrum->[$_]} 0 .. $#$spectrum), -fill => 'blue' ); $mw->MainLoop (); sub NormData { my ($data, $span) = @_; my $min; my $max; for my $datum (@$data) { $min //= $datum; $max //= $datum; $min = $datum if $min > $datum; $max = $datum if $max < $datum; } my $scale = $span / ($max - $min); $_ = $span - ($_ - $min) * $scale + 10 for @$data; return $data; }
    Optimising for fewest key strokes only makes sense transmitting to Pluto or beyond
Who you gonna call? Google Civic Information client & website
6 direct replies — Read more / Contribute
by 1nickt
on Feb 06, 2021 at 23:27

    Google has an API called Civic Information from which one can obtain all the elected officials (from head of state to city council) for a given US address. It's a very cool tool designed to facilitate citizen engagement in government, and I strongly support that.

    I wrote the Perl client for the API (Net::Google::CivicInformation), and based a Dancer2 web app on it, online now at https://contactmyreps.com.

    (At the urging of some of the Dancer2 team I made public the source code repository for the web app. Hope it comes in handy for someone learning to build with Dancer2.)

    In a future release I plan to implement the elections information the API provides. Because silence betokes consent ✌️

    enjoy!

    edit: removed planned feature that's now implemented; added note about public github repo


    The way forward always starts with a minimal test.

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":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
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 romping around the Monastery: (4)
As of 2021-06-17 02:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What does the "s" stand for in "perls"? (Whence perls)












    Results (82 votes). Check out past polls.

    Notices?