Archive for the ‘perl’ Category

TascamSlurp

Friday, February 16th, 2024

This is a perl script that can be used to pull all the files from a DA-6400 and automatically divide them into folders based on their timestamps


#!/usr/bin/perl
$|=1;

$targetbase = “~/DownloadLocation”;
$host = “tascam”;

use Net::FTP;
use Time::Local qw ( timelocal );

use Data::Dumper;

print “Creating FTP object\n”;

$ftp = Net::FTP->new($host, Debug => 0) || die “Can’t connect to tascam”;
print “Logging in\n”;

$ftp->login(“DA-6400″,”DA-6400”) || die “Can’t login ” , $ftp->message;
print “CWD\n”;
$ftp->cwd(“/ssd/DA Files”) || die “Cannot CWD: ” . $ftp->message;
print “BIN\n”;
$ftp->binary() || die “Cannot set to bin mode: ” . $ftp->message;

my $list = $ftp->ls();

my $maxtime = 0;
my $timestamps = {};

# determine newest date
foreach $file (@{$list}) {
next if($file eq “.”);
next if($file eq “..”);
next if(!($file =~ /.*.wav/));

my $unixtime = getFileTimestamp($file);
my $ts = getTimestamp($unixtime);

print “file: [$file] ts: $ts\n”;
$maxtime = $unixtime if($unixtime > $maxtime);
$timestamps->{$unixtime} = 1;
}
foreach $ts (keys %{$timestamps}) {

$targetstub = getTargetDir($ts);
$targetdir = $targetbase . ‘/’ . $targetstub;
if(! -d $targetdir) {
mkdir $targetdir;
} else {
next;
}

$targetdir .= “/ftp”;
if(! -d $targetdir) {
mkdir $targetdir;
}

chdir $targetdir;
print “$ts – Writing to $targetdir\n”;

foreach $file (@{$list}) {
next if($file eq “.”);
next if($file eq “..”);
next if(!($file =~ /.*.wav/));

my $unixtime = getFileTimestamp($file);
if($unixtime == $ts) {
print “Fetching $file ..”;
$ftp->get($file);
print (-s $file);
print “\n”;
}
}
}

sub getTargetDir
{
my $time = shift;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
return sprintf(“%02d%02d%04d”,$mon+1,$mday,$year+1900);
}

sub getTimestamp
{
my $time = shift || time();

my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
return sprintf(“%02d/%02d/%04d-%02d:%02d:%02d”,$mon+1,$mday,$year+1900,$hour,$min,$sec);
}

sub getFileTimestamp
{
my $file = shift;
my ($prefix, $datetime, $take, $channel, $name) = split(/_/, $file);

print “Datetime: [$datetime]\n” if($main::debug);

my ($date, $time) = split(/-/, $datetime);
print “Date: [$date]\n” if($main::debug);

my ($yy, $MM, $dd) = $date =~ /(\d{4})(\d{2})(\d{2})/;
my ($hh, $mm, $ss) = $time =~ /(\d{2})(\d{2})(\d{2})/;

print “yy: [$yy] mm: $mm dd: $dd\n” if($main::debug);

$MM -= 1;
$yy -= 1900;

my $unixtime = timelocal($ss, $mm, $hh, $dd, $MM, $yy);

return $unixtime;
}

Using Device::Hue

Sunday, June 11th, 2023

So, I found a major lack of documentation for Device::Hue, and chatGPT had some information that I would describe as whimsically wrong.

Here’s what I ended up doing to get a working perl setup controlling my hue lights:

1) Put a valid URL in /etc/environment for the key HUE_BRIDGE
2) Put a key in /etc/environment for the key HUE_KEY
3) The following code sets lights 17 and 19 to red:


my $bridge = Device::Hue->new();
$bridge->config();
foreach $light_id (17, 19) {
my $light = $bridge->light($light_id);

$light->set_state( { hue => 0, sat => 254 });
$light->commit();
}

IPC::Shareable sets SIGCHLD to Ignore (I’ll take “Annoying undocumented side effects” for $200, Alex)

Sunday, January 1st, 2023

Just a heads up that hopefully google will index and save someone else from the several hours of digging I’ve just had to do. the perl module IPC::Shareable sets SIG{CHLD} to ignore any time you include it. You can set it back to the default behavior, but until you do, waitpid() is going to return -1 and $? will contain -1 for any pid-waiting you do.

Perl bluetooth communications

Friday, May 20th, 2022

I had a couple of notes on using Net::Bluetooth from a raspberry pi to talk to a Bluetooth serial port because I couldn’t get the example code given with Net::Bluetooth to work.

The following will connect to a mac address and send and receive data from it (in this particular example, a ESP32):


#!/usr/bin/perl

use Net::Bluetooth;
use Data::Dumper;
use IO::Handle;
my $obj = Net::Bluetooth->newsocket(“RFCOMM”);

$addr = ‘C4:4F:33:58:B6:FB’;
$port = 1;

if($obj->connect($addr, $port) != 0) {
die “connect error: $!\n”;
}

my $fh = $obj->perlfh();
$fh->autoflush(1);

sleep(1);

print “sending \n”;

print $fh “V\n”;
print “receiving\n”;

$buf = readline($fh);
print “Fetchhost: $buf\n”;

Perl arg parser

Monday, June 10th, 2013


I use this a lot when writing a simple perl script that I want to take args like –flag and –database=this and –comment=”This is a comment with spaces”

while($arg = shift) {

if(($s1,$s2) = $arg =~ /–(.*)=(.*)/) {
$l1 = lc $s1;
$s2 = $a if(($a) = $s2 =~ /^\”(.*)\”$/);
$arg{$l1} = $s2;
} elsif(($s1) = $arg =~ /–(.*)/) {
$l1 = lc $s1;
$arg{$l1} = 1;
}
}

Stick it in the top of the script, and you can then just use

if($arg{‘flag’}) {

}

$comment = $arg{‘comment’};

and so on and so forth.