* Started Storage->scan_directory() that searches a directory (optionally recursively), recording details about files it finds, including mimetypes./

* Added perl-File-MimeInfo to anvil-core (and built a pile of dependencies for the repos). Signed-off-by: Digimer <digimer@alteeve.ca>
6 years ago · d3b2f2fd35
parent dd2b9ec026
commit d3b2f2fd35
5 changed files with 137 additions and 202 deletions
--- a/Anvil/Tools/Storage.pm
+++ b/Anvil/Tools/Storage.pm
@ -8,6 +8,7 @@ use warnings;
 use Data::Dumper;
 use Scalar::Util qw(weaken isweak);
 use Text::Diff;
+use File::MimeInfo;
 use utf8;

 our $VERSION  = "3.0.0";
@ -26,6 +27,7 @@ my $THIS_FILE = "Storage.pm";
 # read_mode
 # record_md5sums
 # rsync
+# scan_directory
 # search_directories
 # update_config
 # update_file
@ -1734,6 +1736,100 @@ sub rsync
 	return($failed);
 }

+=head2 scan_directory
+
+
+
+=cut
+### TODO: Make this work on remote systems
+sub scan_directory
+{
+	my $self      = shift;
+	my $parameter = shift;
+	my $anvil     = $self->parent;
+	my $debug     = defined $parameter->{debug} ? $parameter->{debug} : 3;
+	
+	# Set a default if nothing was passed.
+	my $directory = defined $parameter->{directory} ? $parameter->{directory} : "";
+	my $recursive = defined $parameter->{recursive} ? $parameter->{recursive} : 0;
+	$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
+		directory => $directory,
+		recursive => $recursive, 
+	}});
+	
+	# Does this directory exist?
+	if (not $directory)
+	{
+		# Not even passed in
+		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->rsync()", parameter => "scan_directory" }});
+		return(1);
+	}
+	if ((not -e $directory) or (not -d $directory))
+	{
+		# Nope.
+		$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0262", variables => { directory => $directory }});
+		return(1);
+	}
+	
+	# Results will be stored in this hash.
+	$anvil->data->{scan}{directories}{$directory}{type} = "directory";
+	
+	# Now lets scan
+	local(*DIRECTORY);
+	opendir(DIRECTORY, $directory);
+	while(my $file = readdir(DIRECTORY))
+	{
+		next if $file eq ".";
+		next if $file eq "..";
+		my $full_path = $directory."/".$file;
+		$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { full_path => $full_path }});
+		if ((-d $full_path) && ($recursive))
+		{
+			# This is a directory, dive into it is asked.
+			$anvil->data->{scan}{directories}{$full_path}{type} = "directory";
+			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
+				"scan::directories::${full_path}::type" => $anvil->data->{scan}{directories}{$full_path}{type}, 
+			}});
+			$anvil->Storage->scan_directory({directory => $full_path, recursive => $recursive});
+		}
+		elsif (-l $full_path)
+		{
+			# Symlink
+			$anvil->data->{scan}{directories}{$full_path}{type}   = "symlink";
+			$anvil->data->{scan}{directories}{$full_path}{target} = readlink($full_path);
+			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
+				"scan::directories::${full_path}::type"    => $anvil->data->{scan}{directories}{$full_path}{type}, 
+				"scan::directories::${full_path}::taarget" => $anvil->data->{scan}{directories}{$full_path}{taarget}, 
+			}});
+		}
+		elsif (-f $full_path)
+		{
+			# Normal file.
+			my @details = stat($full_path);
+			$anvil->data->{scan}{directories}{$full_path}{type}     = "file";
+			$anvil->data->{scan}{directories}{$full_path}{mode}     = sprintf("04%o", $details[2] & 07777);
+			$anvil->data->{scan}{directories}{$full_path}{user_id}  = $details[4];
+			$anvil->data->{scan}{directories}{$full_path}{group_id} = $details[5];
+			$anvil->data->{scan}{directories}{$full_path}{size}     = $details[7];
+			$anvil->data->{scan}{directories}{$full_path}{mtime}    = $details[9];
+			$anvil->data->{scan}{directories}{$full_path}{mimetype} = mimetype($full_path);
+			$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 
+				"scan::directories::${full_path}::type"     => $anvil->data->{scan}{directories}{$full_path}{type}, 
+				"scan::directories::${full_path}::mode"     => $anvil->data->{scan}{directories}{$full_path}{mode}, 
+				"scan::directories::${full_path}::user_id"  => $anvil->data->{scan}{directories}{$full_path}{user_id}, 
+				"scan::directories::${full_path}::group_id" => $anvil->data->{scan}{directories}{$full_path}{group_id}, 
+				"scan::directories::${full_path}::size"     => $anvil->data->{scan}{directories}{$full_path}{size}, 
+				"scan::directories::${full_path}::mtime"    => $anvil->data->{scan}{directories}{$full_path}{mtime}, 
+				"scan::directories::${full_path}::mimetype" => $anvil->data->{scan}{directories}{$full_path}{mimetype}, 
+			}});
+		}
+	}
+	closedir(DIRECTORY);
+	
+	
+	return(0);
+}
+
 =head2 search_directories

 This method returns an array reference of directories to search within for files and directories.
--- a/238
+++ b/238
@ -911,7 +911,7 @@ dnf install bash-completion bind-utils dnf-utils firefox gdm libgcrypt-devel lib
            perl-IO-stringy perl-MailTools perl-Module-Build perl-Module-Install perl-Module-Install-AutoLicense perl-Module-Install-ReadmeFromPod perl-Net-DNS perl-Test-Exception perl-Test-Simple perl-Test-Pod perl-Test-Pod-Coverage \
            perl-Test2-Suite rpm-build systemd-devel texinfo virt-manager wget \
            perl-Params-ValidationCompiler perl-Dist-CheckConflicts perl-namespace-autoclean perl-Test-Fatal perl-Devel-GlobalDestruction perl-IPC-Run3 perl-Specio perl-Sys-Syslog mod_perl postfix perl-DBI perl-IPC-SysV perl-Test perl-Filter rrdtool-perl perl-Test-Warn perl-Date-Manip \
-            perl-MIME-Types python36 docbook-style-xsl libxslt flex kernel-devel
+            perl-MIME-Types python36 docbook-style-xsl libxslt flex kernel-devel perl-IPC-System-Simple xdg-user-dirs perl-Import-Into perl-Class-XSAccessor perl-Sub-Name perl-DynaLoader-Functions perl-Devel-CallChecker perl-Test-Requires


 - Uninstall
@ -922,9 +922,13 @@ dnf remove biosdevname
 * anvil
 * anvil-striker-extra
 * libssh2                              # NOTE! Make sure this comes from F29 (1.8.0-8). The version from RHEL doesn't offer -devel, they say it's deprecated (??). May need to update or replace perl-Net-SSH2
+* perl-B-Compiling
 * perl-Email-Date-Format
 * perl-Exporter-Lite
+* perl-ExtUtils-Depends
 * perl-HTML-Strip
+* perl-File-BaseDir
+* perl-File-MimeInfo
 * perl-IO-CaptureOutput
 * perl-Log-Journald
 * perl-Mail-Sender
@ -932,6 +936,8 @@ dnf remove biosdevname
 * perl-Module-Install-GithubMeta
 * perl-Net-Domain-TLD
 * perl-Proc-Simple
+* perl-Lexical-SealRequireHints
+* perl-Sub-Quote
 * perl-Test-Needs
 * perl-Test-UseAllModules
 * perl-UUID-Tiny
@ -941,237 +947,65 @@ dnf remove biosdevname
 --- Second round of builds;

 rpm -Uvh libssh2  (won't update from 1.8.0-7 from RHEL8 repo to our 1.8.0-8 via dnf update for some reason)
-dnf install perl-IO-CaptureOutput perl-Exporter-Lite perl-Module-Install-GithubMeta perl-Net-Domain-TLD perl-Test-UseAllModules perl-Mail-Sender perl-Mail-Sendmail perl-Test-Needs perl-Email-Date-Format
+dnf install perl-IO-CaptureOutput perl-Exporter-Lite perl-Module-Install-GithubMeta perl-Net-Domain-TLD perl-Test-UseAllModules perl-Mail-Sender perl-Mail-Sendmail perl-Test-Needs perl-Email-Date-Format perl-ExtUtils-Depends perl-B-Compiling perl-Lexical-SealRequireHints \
+            perl-Sub-Quote 

+* perl-B-Hooks-OP-Check
 * perl-Email-Valid
+* perl-Lexical-Var
 * perl-MIME-Lite
 * perl-Module-Install-AutoLicense
 * perl-Net-Netmask

 --- Third round of builds;

-dnf install perl-Email-Valid erl-Module-Install-AutoLicense perl-MIME-Lite 
+dnf install perl-Email-Valid erl-Module-Install-AutoLicense perl-MIME-Lite perl-B-Hooks-OP-Check perl-Lexical-Var

+* perl-bareword-filehandles
+* perl-Devel-Declare            # NOTE: need to boot-strap; [rpmbuild -ba --define='perl_bootstrap=1' perl-Devel-Declare.spec], build perl-Devel-CallParser, rebuild this without bootstrap.
 * perl-Email-Find
 * perl-Log-Dispatch
 * perl-Module-Install-CheckLib
+* perl-multidimensional
+* perl-indirect                 # NOTE: need to boot-strap; [rpmbuild -ba --define='perl_bootstrap=1' perl-indirect.spec], build perl-Devel-CallParser, rebuild this without bootstrap.

 --- Fourth round of builds;

-dnf install perl-Email-Find perl-Module-Install-CheckLib perl-Log-Dispatch
+dnf install perl-Email-Find perl-Module-Install-CheckLib perl-Log-Dispatch perl-Devel-Declare perl-bareword-filehandles perl-multidimensional perl-indirect 

+* perl-Devel-CallParser
 * perl-HTML-FromText
 * perl-Log-Dispatch-FileRotate
 * perl-Net-SSH2
-
+* perl-strictures

 --- Fifth round of builds;

-dnf install perl-Log-Dispatch
+dnf install perl-Log-Dispatch perl-strictures perl-Devel-CallParser

+* perl-Devel-Declare             # Again, without the bootstrapping.
+* perl-indirect                  # Again, without the bootstrapping.
 * perl-Log-Log4perl
+* perl-Moo

+--- Sixth round of builds;

+dnf clean all                    # expire-cache isn't enough to clear the boot-strapped versions
+dnf reinstall perl-Devel-Declare perl-indirect
+dnf install perl-Moo

+* perl-CPAN-Changes

-====== try1
-
-1. dnf install asciidoc bind-utils bison byacc cmake dos2unix freeglut-devel freetype-devel gcc-c++ gd-devel gettext-devel ghostscript graphviz gtk2-devel inkscape libGLU-devel libX11-devel libXext-devel libXi-devel libXmu-devel \
-               libXt-devel libgcrypt-devel libjpeg-devel libpng-devel librsvg2-devel libtiff-devel libtool libtool-ltdl-devel libwebp-devel libxml2-devel lpr mesa-libGL-devel openssl-devel perl "perl(Devel::PPPort)" "perl(Env)" \
-               "perl(ExtUtils::CBuilder)" "perl(File::HomeDir)" perl-File-Remove "perl(File::ShareDir)" "perl(File::Which)" "perl(Locale::Messages)" "perl(Mail::Address)" "perl(Module::Build)" "perl(Module::Pluggable)" \
-               "perl(Module::Runtime)" "perl(Net::DNS)" "perl(Term::ReadKey)" "perl(Test)" "perl(Test::Simple)" "perl(Text::Diff)" "perl(Try::Tiny)" "perl(YAML)" "perl(autodie)" perl-Devel-Peek perl-Pod-Parser perl-Text-Glob \
-               perl-generators "pkgconfig(dbus-1)" "pkgconfig(glib-2.0)" publican python3-devel python3-devel python36 qt5-qtbase-devel systemd-devel texlive-epstopdf "tex(adjustbox.sty)" "tex(appendix.sty)" "tex(dvips)" \
-               "tex(import.sty)" "tex(latex)" "tex(multirow.sty)" "tex(sectsty.sty)" "tex(tabu.sty)" "tex(tocloft.sty)" "tex(xtab.sty)" time valgrind wget xdg-user-dirs xdg-utils xmlto xz-devel zip2-devel zlib-devel
-
-=================
-
-* csnappy
-* doxygen
-* fpaste
-* giflib
-* gtest
-* help2man
-* htop 
-* jbigkit
-* lcms2
-* libssh2
-* libutempter
-* libwmf
-* perl-Capture-Tiny
-* perl-Class-XSAccessor
-* perl-Config-Tiny
-* perl-Class-Data-Inheritable
-* perl-Class-Tiny
-* perl-Devel-CheckBin
-* perl-Devel-Hide
-* perl-Devel-StackTrace
-* perl-Digest-SHA1
-* perl-Encode
-* perl-ExtUtils-Depends
-* perl-Exporter-Lite
-* perl-ExtUtils-Config
-* perl-ExtUtils-Helpers
-* perl-ExtUtils-PkgConfig
-* perl-File-BaseDir
-* perl-File-ReadBackwards
-* perl-File-Remove
-* perl-File-Type
-* perl-Import-Into
-* perl-Importer
-* perl-IO-CaptureOutput
-* perl-IO-String
-* perl-IO-stringy
-* perl-Log-Journald 
-* perl-Mock-Config
-* perl-Module-Install-ExtraTests
-* perl-Module-Pluggable
-* perl-Net-Domain-TLD
-* perl-Number-Compare
-* perl-PadWalker
-* perl-Perl-Destruct-Level
-* perl-Probe-Perl
-* perl-Proc-Simple
-* perl-Scope-Guard
-* perl-File-ShareDir-Install
-* perl-Lingua-EN-Inflect
-* perl-strictures
-* perl-String-Format
-* perl-Sub-Exporter-Progressive
-* perl-Sub-Identify
-* perl-Sub-Uplevel
-* perl-Taint-Runtime
-* perl-Task-Weaken
-* perl-Term-Size-Perl
-* perl-Test-Deep
-* perl-Test-Fatal
-* perl-Test-InDistDir
-* perl-Test-Object
-* perl-Test-Pod
-* perl-Test-Requires
-* perl-Test-Warnings
-* perl-Test-Without-Module
-* perl-YAML-LibYAML
-* perl-YAML-Syck
-* perltidy
-* yasm
-
-2. dnf install csnappy doxygen fpaste giflib gtest help2man htop  jbigkit lcms2 libssh2 libutempter libwmf perl-Capture-Tiny perl-Class-XSAccessor perl-Config-Tiny perl-Class-Data-Inheritable perl-Class-Tiny perl-Devel-CheckBin \
-               perl-Devel-Hide perl-Devel-StackTrace perl-Digest-SHA1 perl-Encode perl-ExtUtils-Depends perl-Exporter-Lite perl-ExtUtils-Config perl-ExtUtils-Helpers perl-ExtUtils-PkgConfig perl-File-BaseDir perl-File-ReadBackwards \
-               perl-File-Remove perl-File-Type perl-Import-Into perl-Importer perl-IO-CaptureOutput perl-IO-String perl-IO-stringy perl-Log-Journald  perl-Mock-Config perl-Module-Install-ExtraTests perl-Module-Pluggable \
-               perl-Net-Domain-TLD perl-Number-Compare perl-PadWalker perl-Perl-Destruct-Level perl-Probe-Perl perl-Proc-Simple perl-Scope-Guard perl-File-ShareDir-Install perl-Lingua-EN-Inflect perl-strictures perl-String-Format \
-               perl-Sub-Exporter-Progressive perl-Sub-Identify perl-Sub-Uplevel perl-Taint-Runtime perl-Task-Weaken perl-Term-Size-Perl perl-Test-Deep perl-Test-Fatal perl-Test-InDistDir perl-Test-Object perl-Test-Pod \
-               perl-Test-Requires perl-Test-Warnings perl-Test-Without-Module perl-YAML-LibYAML perl-YAML-Syck perltidy yasm 
-
-jasper
-libdatrie
-libthai
-libtiff
-* p7zip
-perl-B-Hooks-EndOfScope
-perl-B-Keywords
-perl-Class-Method-Modifiers
-perl-Clone
-perl-Devel-CheckLib
-perl-Devel-Cycle
-perl-Devel-EnforceEncapsulation
-perl-Devel-GlobalDestruction
-perl-Devel-Symdump
-perl-Dist-CheckConflicts
-perl-Email-Find
-perl-Email-Valid
-perl-Encode-EUCJPASCII
-perl-Exception-Class
-perl-Exporter-Tiny
-perl-ExtUtils-InstallPaths
-perl-File-DesktopEntry
-perl-File-Find-Rule
-perl-File-Find-Rule-Perl
-perl-File-MimeInfo
-perl-Font-TTF
-perl-GD
-perl-Getopt-ArgvFile
-perl-Graphics-TIFF
-perl-Hook-LexWrap
-perl-HTML-FromText 
-perl-HTML-Strip 
-perl-IO-All
-perl-List-MoreUtils
-perl-List-MoreUtils-XS
-perl-MCE
-perl-MIME-Charset
-perl-Module-Build-Tiny
-perl-Module-Implementation
-perl-Module-Install
-perl-Module-Install-AuthorRequires
-perl-Module-Install-AuthorTests
-perl-Module-Install-AutoLicense
-perl-Module-Install-CheckLib
-perl-Module-Install-GithubMeta
-perl-Module-Install-ManifestSkip
-perl-Module-Install-ReadmeFromPod
-perl-Module-Install-Repository
-perl-Module-Package
-perl-Module-Package-Au
-perl-Moo
-perl-namespace-autoclean
-perl-namespace-clean
-perl-Net-Netmask 
-perl-Net-SSH2 
-perl-Package-Stash
-perl-Package-Stash-XS
-perl-Paper-Specs
-perl-Path-Class
-perl-Path-Tiny
-perl-PDF-API2
-perl-Perl-Critic
-perl-Perl-Critic-Deprecated
-perl-Perl-Critic-More
-perl-Perl-MinimumVersion
-perl-pod2pdf
-perl-Pod-Coverage
-perl-Pod-Markdown
-perl-Pod-Spell
-perl-PPI
-perl-PPIx-QuoteLike
-perl-PPIx-Regexp
-perl-PPIx-Utilities
-perl-Readonly
-perl-Role-Tiny
-perl-Sereal
-perl-Sereal-Decoder
-perl-Sereal-Encoder
-perl-Sub-Info
-perl-Sub-Name
-perl-Sub-Quote
-perl-Term-Size-Any
-perl-Term-Table
-perl-Test-Differences
-perl-Test-Exception
-perl-Test-LongString
-perl-Test-Memory-Cycle
-perl-Test-Perl-Critic
-perl-Test-Pod-Coverage
-perl-Test-Script
-perl-Test-SubCalls
-perl-Test-UseAllModules
-perl-Test-Warn
-perl-Test2-Suite	                - Needs to be updated! Source from F29 isn't available easily
-perl-Unicode-EastAsianWidth
-perl-Unicode-LineBreak
-perl-Unicode-UTF8
-perl-UUID-Tiny
-perl-Variable-Magic
-perl-YAML-Tiny
-screen
-texinfo
-zstd
+--- Seventh round of builds;
+
+dnf install perl-CPAN-Changes
+
+* perl-File-DesktopEntry
+
+--- Seventh round of builds;

-3. 
+dnf install perl-File-DesktopEntry 

-GraphicsMagick
-miniz
-perl-Image-Size
-sombok


 =======================================
--- a/rpm/SPECS/anvil.spec
+++ b/rpm/SPECS/anvil.spec
@ -41,6 +41,7 @@ Requires:       perl-Data-Dumper
 Requires:       perl-DBD-Pg 
 Requires:       perl-DBI
 Requires:       perl-Digest-SHA
+Requires:       perl-File-MimeInfo
 Requires:       perl-HTML-FromText
 Requires:       perl-HTML-Strip
 Requires:       perl-JSON 
--- a/share/words.xml
+++ b/share/words.xml
@ -556,6 +556,7 @@ Finished Downloading: [#!variable!file!#].
 - Download rate: [#!variable!rate!#]
 		</key>
 		<key name="log_0261">#!variable!file!# was called, but no files where available for download in CGI. Was the variable name 'upload_file' used?</key>
+		<key name="log_0262">[ Error ] - Storage->scan_directory() was asked to scan: [#!variable!directory!#], but it doesn't exist or isn't actually a directory.</key>
 		
 		<!-- Test words. Do NOT change unless you update 't/Words.t' or tests will needlessly fail. -->
 		<key name="t_0000">Test</key>
--- a/tools/striker-manage-install-target
+++ b/tools/striker-manage-install-target
@ -1819,7 +1819,10 @@ sub load_packages
 			"perl-Eval-Closure.noarch",
 			"perl-Exception-Class.noarch",
 			"perl-Exporter.noarch",
+			"perl-File-BaseDir", 
+			"perl-File-DesktopEntry", 
 			"perl-File-Listing.noarch",
+			"perl-File-DesktopEntry", 
 			"perl-File-Path.noarch",
 			"perl-File-Temp.noarch",
 			"perl-Getopt-Long.noarch",