sub process_modules {
    my ($active_modules_ref) = @_;  # Accept %active_modules as a refe
+rence
    my %module_map = (
        'clouds'    => sub { CloudUpdate::cloud_update() },
        'volcanoes' => sub { VolcanoXML::process_volcano_data() },
        'storms'    => sub { Storm::fetch_and_process_storms() },
        'quakes'    => sub { Earthquake::get_quakedata() },
        'norad'     => sub {
            my $satellite_file = "$xplanet_satellites_dir\\Norad";
            my $output_tle_file = "$xplanet_satellites_dir\\Norad.tle"
+;
            my $marker_file = "$xplanet_satellites_dir\\Norad_marker.t
+xt";
            Norad::process_satellites($satellite_file, $output_tle_fil
+e, $marker_file);
        },
        'fires'     => sub { Fires::run() },
        'labelupdate' => sub {
            print "process_modules - Debug: Calling WriteoutLabel with
+ active_modules_ref:\n" if $DEBUG;
            foreach my $key (keys %$active_modules_ref) {
                print "  $key => $active_modules_ref->{$key}\n" if $DE
+BUG;
            }
            Label::WriteoutLabel($active_modules_ref);  # Pass as a re
+ference
        },
    );

    foreach my $module (keys %Globals::modules) {
        my ($onoff_key) = grep { /onoff$/i } keys %{ $Globals::modules
+{$module} };

        if ($onoff_key && $Globals::modules{$module}{$onoff_key} == 1)
+ {
            print "Processing module: $module\n" if $DEBUG;

            if (exists $module_map{$module}) {
                $module_map{$module}->($active_modules_ref);
            } else {
                warn "No subroutine mapped for module: $module\n" if $
+DEBUG;
            }
        } else {
            print "Module: $module, On/Off: Undefined or Inactive\n" i
+f $DEBUG;
        }
    }
}
[download]

'labelupdate' => sub {
            print "process_modules - Debug: Calling WriteoutLabel with
+ active_modules_ref:\n" if $DEBUG;
            foreach my $key (keys %$active_modules_ref) {
                print "  $key => $active_modules_ref->{$key}\n" if $DE
+BUG;
            }
            Label::WriteoutLabel($active_modules_ref);  # Pass as a re
+ference
[download]

# Process modules
process_modules(\%active_modules);
[download]

package Label;
use strict;
use warnings;
use Data::Dumper;
use Time::Local;  # Load the Time::Local module

use Globals qw(
    $DEBUG 
    $label_file 
    $labelsettings
);  


sub WriteoutLabel {
    print "Label line 31 - Debug: \$DEBUG is " . ($DEBUG ? "enabled" :
+ "disabled") . "\n";

    my ($active_modules_ref) = @_;

    # Skip label generation if labelsdisplay is disabled
    my $labels_display = $Globals::modules{'labels'}{'labelsonoff'} //
+ 1;  # Default to 1 (enabled)
    return unless $labels_display;

    print "Label line 39 - Debug: Labels display is " . ($labels_displ
+ay ? "enabled" : "disabled") . "\n" if $DEBUG;

    # Debug: Check that active_modules_ref is a hash reference
    unless (ref $active_modules_ref eq 'HASH') {
        print "Label::WriteoutLabel - Received invalid active_modules_
+ref: " . (ref $active_modules_ref || 'undefined') . "\n" if $DEBUG;
        die "Error: active_modules_ref is not a HASH reference.";
    }
...
[download]

Q: What can I use in a Dancer2 before hook to cause the request being processed to hand back an HTTP error?

Say I have a before hook that will filter out requests which are not worth processing. I would like to short-circuit the request and simply return, say, a 404. I've tried variations on bare return, returning a Dancer2::Core::Error object or the result of calling ->throw on one with no luck. I can abort with a 'die' but that leaves me returning a 500, not a 404 whatever. There is documentation in Dancer2 on handling errors generated by Dancer2 itself, but I cannot find anything that describes how to raise an error/exception/whatever from the Perl code running in handlers. The simplest example I can think of is a lightweight handler that rejects botched requests based on IP, username, etc, that are blacklisted.

hook before => sub
{
    ...
    is_bogus_request $request and ... # what???
};
[download]

Hi. I got some code from this site that demonstrates "-textvariable" usage. However, there are some basic questions I have about it's operation. The code is;

 
#!/usr/bin/perl

use strict;
use warnings;

use Tk;
use POSIX;

my $red;
my $green;
my $blue;

my $mw = MainWindow->new;
$mw->geometry('300x100');   # x amount then y amount
$mw->title('Raw Renamer');

# A frame for labels on the left hand size
my $left_frame = $mw->Frame (-borderwidth => 2, -relief => 'groove')
                            ->pack(-side   => 'left',
                                   -anchor => 'n',
                                   -expand => 1);
                                   
my $text_label = $left_frame->Label->pack(-side => 'left',       # Why
+ this ?
                                          -anchor => 'n',
                                          -expand => 1);

$text_label->Label(-text =>"Red")->pack(  -side   => 'top',
                                          -anchor => 'w');
$text_label->Label(-text =>"Green")->pack(-side   => 'top',
                                          -anchor => 'w');
$text_label->Label(-text =>"Blue")->pack( -side   => 'top',
                                          -anchor => 'w');

# Another frame for the ($red $green $blue) variables
my $variable_frame = $mw->Frame (-borderwidth => 4, -relief => 'groove
+')
                               ->pack(-side   => 'left',
                                      -anchor => 'n',
                                      -expand => 1);

my $red_label   = $variable_frame->Label(-textvariable =>\$red)  ->pac
+k(-side => 'top');
my $green_label = $variable_frame->Label(-textvariable =>\$green)->pac
+k(-side => 'top');
my $blue_label  = $variable_frame->Label(-textvariable =>\$blue) ->pac
+k(-side => 'top');

Intialize();                # How is this infinite loop bypassed ?
MainLoop;

sub Intialize
{
    print "Str";
    while(1)
    { 
        print ".";
        $red  = floor(50*rand());
        $red_label->update;
        sleep 2;
        
        $green = floor(50*rand()+50);
        $green_label->update;
        sleep 2;
        
        $blue = floor(50*rand()+100);
        $blue_label->update;
        sleep 2;
    }
}
[download]

The line "my $text_label" seems to be half a declaration that is used in an anonymous fashion in the subsequent 3 labels. Is this the case ?. I tried removing the "pack" part expecting that this is not required. But it is required.

Next, the call "Intialize();" should get stuck in an infinite loop. But it does not and the program runs OK? and the "MainLoop;" gives a display screen.

Regard JC.......

Hi Monks. I have built a minicpan on a Gnu/Linux box and now I am struggling with getting cpan (so far, not trying cpanminus or cpanplus) to find and query my local repository. I have a feeling based on SuperSearch and Google, that this has been discussed often, and I ask the esteemed Monks for their forbearance.

My minicpan is rooted at /var/mirrors/minicpan and I am not clear on whether to push file:///var/mirrors/minicpan or file:///var/mirrors/minicpan/sources into urllist. I am also not sure whether there should be 3 slashes after file: or only two.I've tried every combination of these variable things and nothing works. One node, Offline cpan used by strawberry perl seem to indicate that 3 slashes are needed. There is also a discussion over at StackOverflow that inconclusively debates what the pushy_https configure parameter does.

When I write "nothing works" I mean that this happens:

cpan18> install Net::HTTP::Tiny
Warning: Cannot install Net::HTTP::Tiny, don't know what it is.
Try the command
i /Net::HTTP::Tiny/
to find objects with matching identifiers.

This is always the result. I know the packages I want are in my minicpan. Any help would be appreciated.

Is there an easy way to indent an unindented XML file?

Of course, significant whitespace between two adjacent elements or in mixed content should not be obscured or lost

The data have an encoding ISO-8859-1 and contain tons of XML entities defined in a DTD with external entity declarations in a subdirectory

sample input
<?xml version="1.0" encoding="ISO-8859-1"?><root><para><pnum>1</pnum><ptext>This is a sample of a very specific text <emph>called</emph> <term>description</term> which has 2 subtypes: <list><item><term>1.</term><p>precise</p></item><item><term>2.</term><p>fuzzy</p></item></list></ptext></para></root>

The output should look like this:

<?xml version="1.0" encoding="ISO-8859-1"?>
<root>
    <para>
        <pnum>1</pnum>
        <ptext>This is a sample of a very specific text <emph>called</
+emph> <term>description</term> which has 2 subtypes: 
            <list>
                <item>
                    <term>1.</term>
                    <p>precise</p>
                </item>
                <item>
                    <term>2.</term>
                    <p>fuzzy</p>
                </item>
            </list>
        </ptext>
    </para>
</root>
[download]

Originally posted as a comment under Problem using NET::LDAP with multiple ldap servers

I am running into this issue when I use a load balancer dns alias which has multiple ldap servers. It's not possible to input all of the individual ldap servers in the subroutine. Is there any other solution to this issue?

here is my code:

my $ldap = Net::LDAP->new( $host, port => $port, version => 3 ) or die
+ "$@";
[download]

If I hard code one of the ldap server in the same code, it works!
eg:

my $ldap = Net::LDAP->new( 'myldap.server.com', port => $port, version
+ => 3 ) or die "$@";
[download]

Hi (again). I am using the Tk module with a Checkbutton routine as follows;

# Set up frames to contain all the pids (for selection) 
my $frame_pids;
$frame_pids = $main->Frame(-borderwidth => 2, -relief => 'groove'); 
   
my @sortedKeys = ( sort keys %IdxToNickName );
for my $k (@sortedKeys) {
   my $pid_nickname = $IdxToNickName{$k};
      
   my $cb = $frame_pids->Checkbutton( 
      -text     => sprintf("%-15s",$pid_nickname), 
                   # courier and -15 implies fixed length left justifi
+ed
      -variable => \$IdxToNickNameSel{$k},
                   # this is a hash for the selection result (so other
+s can access)
      -font     => ['courier', 10, 'bold'] 
                   #       and a font size   
      );
     
   $IdxToNickNameSel{$k} = 0;        # Initialise the selection to 0
      
   $cb->pack(-side => 'top');        # Pack the cb according to left c
+riteria    
}
[download]

This permits me to have the checkbutton selections reference by the whole of the program (using "-variable"). For my next step I would like to selectively product the results and load into a hash which in turn is reflected onto the screen. What is the best way to achieve this output ??

I expect the "-variable" option needs to be available, this this does not seem to be available for Text and Labels.

Regards JC......

I'm trying to get a slice of a 2D PDL array and am having problems finding good examples of this. What I am trying to do is take Tick data and create create a OHLCV array based on a summarization of x number seconds. Any help would be apreciated. My code is below

#!/usr/bin/env perl
use strict;
use warnings;
use PDL;
use PDL::NiceSlice;
use Time::Local;

# Sample tick data: array of arrays [timestamp, price, volume]
# Example: ["2025-01-12 09:30:00", 100.5, 200]
my $tick_data = [
    ["2025-01-12 09:30:00", 100.5, 200],
    ["2025-01-12 09:30:15", 101.0, 150],
    ["2025-01-12 09:30:30", 100.8, 100],
    ["2025-01-12 09:30:45", 101.2, 300],
    ["2025-01-12 09:31:00", 101.0, 250],
];

# Group data into OHLCV intervals (e.g., 1 minute)
my $interval_seconds = 20; # Set interval in seconds

# Helper: Convert timestamp to epoch
sub timestamp_to_epoch {
    my ($timestamp) = @_;
    my ($date, $time) = split(' ', $timestamp);
    my ($year, $month, $day) = split('-', $date);
    my ($hour, $min, $sec) = split(':', $time);
    return timelocal($sec, $min, $hour, $day, $month - 1, $year);
}

# Pre-process: Add epoch to data
my $data = pdl([
    map {
        my $epoch = timestamp_to_epoch($_->[0]);
        [$epoch, $_->[1], $_->[2]]
    } @$tick_data
]);

for my $i (0..$data->dim(1)-1) {
   my $ts = $data->at(0,$i);
   my $p = $data->at(1,$i);
   my $v = $data->at(2,$i);
   }

# Find unique interval buckets
my $start_epoch = $data((0), 0);
my $intervals   = floor(($data(0, -1) - $start_epoch) / $interval_seco
+nds);

# Compute OHLCV
my ($open, $high, $low, $close, $volume) = ([], [], [], [], []);

for my $i (0 .. max($intervals)) {
    my $group = $data->where(floor(($data - $start_epoch) / $interval_
+seconds)== $i);
    next if $group->nelem == 0; # Skip empty groups

#    push @$open, $group(0, 1); # First price
#    push @$high, max($group(:, 1));
#    push @$low,  min($group(:, 1));
#    push @$close, $group((($group->dim(0) - 1)), 1); # Last price
#    push @$volume, sum($group(:, 2));
}

# Convert OHLCV to PDL for display
#my $ohlcv = pdl($open, $high, $low, $close, $volume)->transpose;

# Output results
#print "OHLCV Format (Open, High, Low, Close, Volume):\n";
#print $ohlcv;
[download]