seasharp
/
anvil
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source 
* Added perl-File-MimeInfo to anvil-core (and built a pile of dependencies for the repos).

Signed-off-by: Digimer <digimer@alteeve.ca>
main
Digimer 6 years ago
parent dd2b9ec026
commit d3b2f2fd35
5 changed files with 137 additions and 202 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 96
      Anvil/Tools/Storage.pm
  2. 238
      notes
  3. 1
      rpm/SPECS/anvil.spec
  4. 1
      share/words.xml
  5. 3
      tools/striker-manage-install-target

96
Anvil/Tools/Storage.pm
Unescape View File

@ -8,6 +8,7 @@ use warnings;
use Data::Dumper; use Data::Dumper;
use Scalar::Util qw(weaken isweak); use Scalar::Util qw(weaken isweak);
use Text::Diff; use Text::Diff;
use File::MimeInfo;
use utf8; use utf8;
our $VERSION = "3.0.0"; our $VERSION = "3.0.0";
@ -26,6 +27,7 @@ my $THIS_FILE = "Storage.pm";
# read_mode # read_mode
# record_md5sums # record_md5sums
# rsync # rsync
# scan_directory
# search_directories # search_directories
# update_config # update_config
# update_file # update_file
@ -1734,6 +1736,100 @@ sub rsync
return($failed); 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 =head2 search_directories
This method returns an array reference of directories to search within for files and directories. This method returns an array reference of directories to search within for files and directories.

238
notes
Unescape View File

@ -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-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-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-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 - Uninstall
@ -922,9 +922,13 @@ dnf remove biosdevname
* anvil * anvil
* anvil-striker-extra * 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 * 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-Email-Date-Format
* perl-Exporter-Lite * perl-Exporter-Lite
* perl-ExtUtils-Depends
* perl-HTML-Strip * perl-HTML-Strip
* perl-File-BaseDir
* perl-File-MimeInfo
* perl-IO-CaptureOutput * perl-IO-CaptureOutput
* perl-Log-Journald * perl-Log-Journald
* perl-Mail-Sender * perl-Mail-Sender
@ -932,6 +936,8 @@ dnf remove biosdevname
* perl-Module-Install-GithubMeta * perl-Module-Install-GithubMeta
* perl-Net-Domain-TLD * perl-Net-Domain-TLD
* perl-Proc-Simple * perl-Proc-Simple
* perl-Lexical-SealRequireHints
* perl-Sub-Quote
* perl-Test-Needs * perl-Test-Needs
* perl-Test-UseAllModules * perl-Test-UseAllModules
* perl-UUID-Tiny * perl-UUID-Tiny
@ -941,237 +947,65 @@ dnf remove biosdevname
--- Second round of builds; --- 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) 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-Email-Valid
* perl-Lexical-Var
* perl-MIME-Lite * perl-MIME-Lite
* perl-Module-Install-AutoLicense * perl-Module-Install-AutoLicense
* perl-Net-Netmask * perl-Net-Netmask
--- Third round of builds; --- 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-Email-Find
* perl-Log-Dispatch * perl-Log-Dispatch
* perl-Module-Install-CheckLib * 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; --- 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-HTML-FromText
* perl-Log-Dispatch-FileRotate * perl-Log-Dispatch-FileRotate
* perl-Net-SSH2 * perl-Net-SSH2
* perl-strictures
--- Fifth round of builds; --- 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-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 --- Seventh round of builds;
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 \ dnf install perl-CPAN-Changes
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-File-DesktopEntry
"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)" \ --- Seventh round of builds;
"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
3. dnf install perl-File-DesktopEntry
GraphicsMagick
miniz
perl-Image-Size
sombok
======================================= =======================================

1
rpm/SPECS/anvil.spec
Unescape View File

@ -41,6 +41,7 @@ Requires: perl-Data-Dumper
Requires: perl-DBD-Pg Requires: perl-DBD-Pg
Requires: perl-DBI Requires: perl-DBI
Requires: perl-Digest-SHA Requires: perl-Digest-SHA
Requires: perl-File-MimeInfo
Requires: perl-HTML-FromText Requires: perl-HTML-FromText
Requires: perl-HTML-Strip Requires: perl-HTML-Strip
Requires: perl-JSON Requires: perl-JSON

1
share/words.xml
Unescape View File

@ -556,6 +556,7 @@ Finished Downloading: [#!variable!file!#].
- Download rate: [#!variable!rate!#] - Download rate: [#!variable!rate!#]
</key> </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_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. --> <!-- Test words. Do NOT change unless you update 't/Words.t' or tests will needlessly fail. -->
<key name="t_0000">Test</key> <key name="t_0000">Test</key>

3
tools/striker-manage-install-target
Unescape View File

@ -1819,7 +1819,10 @@ sub load_packages
"perl-Eval-Closure.noarch", "perl-Eval-Closure.noarch",
"perl-Exception-Class.noarch", "perl-Exception-Class.noarch",
"perl-Exporter.noarch", "perl-Exporter.noarch",
"perl-File-BaseDir",
"perl-File-DesktopEntry",
"perl-File-Listing.noarch", "perl-File-Listing.noarch",
"perl-File-DesktopEntry",
"perl-File-Path.noarch", "perl-File-Path.noarch",
"perl-File-Temp.noarch", "perl-File-Temp.noarch",
"perl-Getopt-Long.noarch", "perl-Getopt-Long.noarch",

Write Preview
Loading…
Cancel
Save