From 687449f8714ce10544c4b4c95e8c74f4799b4b13 Mon Sep 17 00:00:00 2001 From: Will Budic Date: Thu, 15 May 2025 18:23:11 +1000 Subject: [PATCH] init --- index.cgi | 116 ++++++++++++++++ install_cpan_modules_required.pl | 220 +++++++++++++++++++++++++++++++ 2 files changed, 336 insertions(+) create mode 100755 index.cgi create mode 100755 install_cpan_modules_required.pl diff --git a/index.cgi b/index.cgi new file mode 100755 index 0000000..46a1fa7 --- /dev/null +++ b/index.cgi @@ -0,0 +1,116 @@ +#!/usr/bin/env perl +# A delegated CNFParser processed rendering of the Document Index Web page, a Model-View-Controller Pattern approuch. +# The index.cnf script contains the structure and page skeleton, +# all configuration as well as the HTMLIndexProcessorPlugin converting the CNF to final HTML. +# It is very convienient, as both style and script for the page is separated and developed in the index.cnf. +# Which then can be moved to a respective include file over there. +# This controller binds and provides to the parser to do its magic thing. +# +use v5.30; +use strict; +use warnings; +use Exception::Class ('LifeLogException'); +use Syntax::Keyword::Try; +## +# We use dynamic perl compilations. The following ONLY HERE required to carp to browser on +# system requirments or/and unexpected perl compiler errors. +## +use CGI::Carp qw(fatalsToBrowser set_message); + +BEGIN { + sub handle_errors { + my $err = shift; + say "

Server Error

Error: $err

"; + } + set_message(\&handle_errors); +} + +use lib "system/modules"; +require CNFParser; +require CNFNode; + +our $GLOB_HTML_SERVE = "'{}/*.cgi' '{}/*.htm' '{}/*.html' '{}/*.md' '{}/*.txt'"; +our $script_path = $0; $script_path =~ s/\w+.cgi$//; + +exit &HTMLPageBuilderFromCNF; + +sub HTMLPageBuilderFromCNF { + my $html = obtainDirListingHTML('docs'); + my $cnf = CNFParser -> new ( + $script_path."index.cnf",{ + DO_ENABLED => 1, HAS_EXTENSIONS=>1, + ANONS_ARE_PUBLIC => 1, + PAGE_HEAD => "

Index Page of Docs Directory

", + PAGE_CONTENT => $html, + PAGE_FOOT => "" + } + ); + my $ptr = $cnf->data(); + $ptr = $ptr->{'PAGE'}; + say $$ptr if $ptr; + return 0 +} + +sub obtainDirListingHTML { + my ($dir, $ret) = (shift,""); + my $html = listFiles($dir,$script_path,""); + if($html){ + $ret .="

$dir →

"; + } + return $ret; +} + +sub listFiles ($){ + my ($dir, $script_path, $ret) = @_; + my $path = $script_path.$dir; + my $spec = $GLOB_HTML_SERVE; $spec =~ s/{}/$path/gp; + my @files = glob ($spec); + @files = sort { + ( $a=~m/\w+[_-]*/ eq $b=~m/\w+[_-]*/ && length $a > length $b) || + $a <=> $b + } @files; + foreach my $file(@files){ + ($file =~ m/(\w+\.\w*)$/g); + my $name = $1; + if($file =~ /\.md$/){ + my @title = getDocTitle($file); + $ret .= qq(\t\t\t

$title[1] ‐ $name

\n); + }else{ + $ret .= qq(\t\t\t

$name

\n); + } + } + + return $ret; +} + +sub getDocTitle($){ + my ($file,$ret) = shift; + open(my $fh, '<', $file) or LifeLogException->throw("Can't open $file: $!"); + while (my $line = <$fh>) { + if($line =~ /^#+\s*(.*)/){ + $ret = $1; + last; + } + } + close $fh; + ($file =~ m/(\w+\.\w*)$/g); + return ($1,$ret) +} +1; +=begin copyright +Programed by : Will BudiÄ +EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md) +Source : https://github.com/wbudic/LifeLog +Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md +=cut copyright diff --git a/install_cpan_modules_required.pl b/install_cpan_modules_required.pl new file mode 100755 index 0000000..c573912 --- /dev/null +++ b/install_cpan_modules_required.pl @@ -0,0 +1,220 @@ +#!/usr/bin/env perl +## +# Module installer for projects. +# Run this script from any Project directory containing perl modules or scripts. +## +use warnings; use strict; +### +# Prerequisites for this script itself. Run first: +# cpan Term::ReadKey; +# cpan Term::ANSIColor; +## no critic (ProhibitStringyEval) +use Term::ReadKey; +use Term::ANSIColor qw(:constants); + +use constant PERL_FILES_GLOB => "*local/*.pl local/*.pm system/modules/*.pm tests/*.pm tests/*.pl *.pl *.pm *.cgi"; + +my $project = `pwd`."/".$0; $project =~ s/\/.*.pl$//g; $project =~ s/\s$//g; +my @user_glob; +our $PERL_VERSION = $^V->{'original'}; my $ERR = 0; my $key; + +print WHITE "\n *** Project Perl Module Installer coded by ",BRIGHT_RED, "https://github.com/wbudic", WHITE,"***", qq( + \nRunning scan on project path:$project + \nYou have Perl on $^O [$^X] version: $PERL_VERSION\n +); +print BLUE "<<@<\@INC<\n# Your default module package paths:\n", YELLOW; +local $. = 0; foreach(@INC){ + print $.++.".: $_\n"; +} +print BLUE ">>\n", RESET; +if($> > 0){ + print "You are NOT installing system wide, which is required for webservers CGI.\nAre you sure about this?\n" +}else{ + print "You are INSTALLING modules SYSTEM WIDE, are you sure about this?\n" +} +if(@ARGV==0){ + print qq(\nThis program will try to figure out now all the modules + required for this project, and install them if missing. + This can take some time. + ); + print RED "Do you want to proceed (press either the 'Y'es or 'N'o key)?", RESET; + +do{ + ReadMode('cbreak'); + $key = ReadKey(0); print "\n"; + ReadMode('normal'); + exit 1 if(uc $key eq 'N'); + $key = "[ENTER]" if $key =~ /\n/; + print "You have pressed the '$key' key, that is nice, but why?\nOnly the CTRL+C/Y/N keys do something normal." if uc $key ne 'Y'; + }while(uc $key ne 'Y'); +} +else{ + foreach(@ARGV){ + if(-d $_){ + $_ =~ s/\s$//g; + print "\nGlobing for perl files in $project/$_"; + my @located = glob("$_/*.pl $_/*.pm"); + print " ... found ".@located." files."; + push @user_glob, @located; + + }else{ + warn "Argument: $_ is not a local directory." + } + } +} + +my @locals=(); +print "\nGlobing for perl modules in project $project"; +my @perl_files = glob(PERL_FILES_GLOB); +print " ... found ".@perl_files." files.\n"; +push @perl_files, @user_glob; +my %modules; my %localPackages; +foreach my $file(@perl_files){ + next if $0 =~ /$file$/; + if($file =~ /(\w*)\.pm$/){ + $localPackages{$1}=$file; + } + print "\nExamining:$file\n"; + my $res = `perl -ne '/\\s*(^use\\s([a-zA-Z:]*))\\W/ and print "\$2;"' $file`; + my @list = split(/;+/,$res); + foreach(@list){ + if($_=~ /^\w\d\.\d+.*/){ + print "\tA specified 'use $_' found in ->$file\n"; + if($PERL_VERSION ne $_){ + $_ =~s/^v//g; + my @fv = split(/\./, $_); + $PERL_VERSION =~s/^v//g; + my @pv = split(/\./, $PERL_VERSION); + push @fv, 0 if @fv < 3; + for my$i(0..$#fv){ + if( $pv[$i] < $fv[$i] ){ + $ERR++; print "\n\t\033[31mERROR -> Perl required version has been found not matching.\033[0m\n"; + last + } + } + } + } + } + foreach(@list){ + $_ =~ s/^\s*|\s*use\s*//g; + $_ =~ s/[\'\"].*[\'\"]$//g; + next if !$_ or $_ =~ /^[a-z]|\d*\.\d*$|^\W/; + $_ =~ s/|$.*$|qw$.*$//g; + $modules{$_}=$file if $_; + print "$_\n"; + } + if($file=~/\.pm$/){# it is presumed local package module. + $locals[@locals] = `perl -ne '/\\s*(^package\\s(\\w+))/ and print "\$2" and exit' $file`; + } +} + +print WHITE "\nList of Modules required for thie project:\n"; +my @missing=(); +foreach my $mod (sort keys %modules){ + my $missing; + eval "use $mod"; + if ($@){ + $missing[@missing] = $mod; + print MAGENTA "\t$mod \t in ", $modules{$mod}," is suspicious?\n"; + }else{ + print BLUE "\t$mod\n" + } +}foreach(@missing){ + if(exists $localPackages{$_}){ + delete $modules{$_} + }else{ + print BRIGHT_RED $_, MAGENTA, " is missing!\n" + } +} +my %skip_candidates; +my $missing_count = @missing; +if($missing_count>0){ + foreach my $candidate(@missing){ + foreach(@locals){ + if($_ eq $candidate && not exists $skip_candidates{$_}){ + $missing_count--; + $skip_candidates{$_} = 1; + print GREEN, "Found the missing $candidate module in locals.\n" + } + } + } +} +my $perls = `whereis perl`; +print GREEN, "Following is all of ",$perls; +print YELLOW, "Reminder -> Make sure you switched to the right brew release.\n" if $perls =~ /perlbrew/; +print RESET, "Number of local modules:",scalar(@locals),"\n"; +print RESET, "Number of external modules:",scalar(keys %modules),"\n"; +print RESET, "Number of cpan modules about to be tried to install:",$missing_count,"\n"; + +print GREEN, qq( +Do you still want to continue to compile/test/install or check further modules? +Only the first run is the depest and can take a long time, i.e. if you have to install over 5 modules. +At other times this will only check further your current status. + +Now (press either the 'Y'es or 'N'o key) please?), RESET; +do{ +ReadMode('cbreak'); +$key = ReadKey(0); print "\n"; +ReadMode('normal'); + exit 1 if(uc $key eq 'N'); + $key = "[ENTER]" if $key =~ /\n/; + print "You have pressed the '$key' key, that is nice, but why?\nOnly the CTRL+C/Y/N keys do something normal.\n" if uc $key ne 'Y'; +}while(uc $key ne 'Y'); + +my ($mcnt,$mins) = (0,0); +my @kangaroos = sort keys %skip_candidates; + +## +# Some modules if found to be needed to be forcefeed. can be hardcoded here my friends, why not? +## +foreach (( + 'LWP::Simple', + 'LWP::Protocol::https', + 'XML::LibXML::SAX' +)){ + $modules{$_}=1; print "Forcefeed: $_\n" +} + +MODULES_LOOP: +foreach my $mod (sort keys %modules){ + + foreach(@kangaroos){ + if($_ eq $mod){ + next MODULES_LOOP + } + } + $mcnt++; + ## no critic (ProhibitStringyEval) + eval "use $mod"; + if ($@) { + system(qq(perl -MCPAN -e 'install $mod')); + if ($? == -1) { + print "failed to install: $mod\n"; + }else{ + my $v = eval "\$$mod\::VERSION"; + $v = $v ? "(v$v)" : ""; + print "Installed module $mod $v!\n"; + $mins++ + } + }else{ + $mod =~ s/\s*$//; + my $v = eval "\$$mod\::VERSION"; + $v = $v ? "(v$v)" : ""; + print "Skipping module $mod $v, already installed!\n"; + } +} +print "\nProject $project\nRequires $mcnt modules.\nInstalled New: $mins\n"; +print "WARNING! - This project requires in ($ERR) parts code that might not be compatible yet with your installed/running version of perl (v$PERL_VERSION).\n" +if $ERR; + + +=begin copyright +Programed by : Will Budic +EContactHash : 990MWWLWM8C2MI8K (https://github.com/wbudic/EContactHash.md) +Source : https://github.com/wbudic/PerlCNF.git +Documentation : Specifications_For_CNF_ReadMe.md + This source file is copied and usually placed in a local directory, outside of its repository project. + So it could not be the actual or current version, can vary or has been modiefied for what ever purpose in another project. + Please leave source of origin in this file for future references. +Open Source Code License -> https://github.com/wbudic/PerlCNF/blob/master/ISC_License.md +=cut copyright -- 2.34.1