From 6e9e8ab368c1cbe12e2ba79195e5694fd745fa84 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 16 Apr 2022 22:53:13 -0700 Subject: minor archive out of bin/ and perl5/ --- perl5/File/XDG.pm | 237 ------------------------------------------------- perl5/ShellSequence.pm | 133 --------------------------- perl5/TestExec.pm | 18 ---- 3 files changed, 388 deletions(-) delete mode 100644 perl5/File/XDG.pm delete mode 100644 perl5/ShellSequence.pm delete mode 100755 perl5/TestExec.pm (limited to 'perl5') diff --git a/perl5/File/XDG.pm b/perl5/File/XDG.pm deleted file mode 100644 index 30dc672e..00000000 --- a/perl5/File/XDG.pm +++ /dev/null @@ -1,237 +0,0 @@ -package File::XDG; - -use strict; -use warnings; -use feature qw(:5.10); - -our $VERSION = 0.04; - -use Carp qw(croak); - -use Path::Class qw(dir file); -use File::HomeDir; - -=head1 NAME - -C - Basic implementation of the XDG base directory specification - -=head1 SYNOPSIS - - use File::XDG; - - my $xdg = File::XDG->new(name => 'foo'); - - # user config - $xdg->config_home - - # user data - $xdg->data_home - - # user cache - $xdg->cache_home - - # system config - $xdg->config_dirs - - # system data - $xdg->data_dirs - -=head1 DESCRIPTION - -This module provides a basic implementation of the XDG base directory -specification as exists by the Free Desktop Organization (FDO). It supports -all XDG directories except for the runtime directories, which require session -management support in order to function. - -=cut - -=head1 CONSTRUCTOR - -=cut - -=head2 $xdg = File::XDG->new( %args ) - -Returns a new instance of a C object. This must be called with an -application name as the C argument. - -Takes the following named arguments: - -=over 8 - -=item name => STRING - -Name of the application for which File::XDG is being used. - -=back - -=cut - -sub new { - my $class = shift; - my %args = (@_); - - my $self = { - name => delete $args{name} // croak('application name required'), - }; - - return bless $self, $class || ref $class; -} - -sub _win { - my ($type) = @_; - - return File::HomeDir->my_data; -} - -sub _home { - my ($type) = @_; - my $home = $ENV{HOME}; - - return _win($type) if ($^O eq 'MSWin32'); - - given ($type) { - when ('data') { - return ($ENV{XDG_DATA_HOME} || "$home/.local/share/") - } when ('config') { - return ($ENV{XDG_CONFIG_HOME} || "$home/.config/") - } when ('cache') { - return ($ENV{XDG_CACHE_HOME} || "$home/.cache/") - } default { - croak 'invalid _home requested' - } - } -} - -sub _dirs { - my $type = shift; - - given ($type) { - when ('data') { - return ($ENV{XDG_DATA_DIRS} || '/usr/local/share:/usr/share') - } when ('config') { - return ($ENV{XDG_CONFIG_DIRS} || '/etc/xdg') - } default { - croak 'invalid _dirs requested' - } - } -} - -sub _lookup_file { - my ($self, $type, @subpath) = @_; - - unless (@subpath) { - croak 'subpath not specified'; - } - - my @dirs = (_home($type), split(':', _dirs($type))); - my @paths = map { file($_, @subpath) } @dirs; - my ($match) = grep { -f $_ } @paths; - - return $match; -} - -=head1 METHODS - -=cut - -=head2 $xdg->data_home() - -Returns the user-specific data directory for the application as a C object. - -=cut - -sub data_home { - my $self = shift; - my $xdg = _home('data'); - return dir($xdg, $self->{name}); -} - -=head2 $xdg->config_home() - -Returns the user-specific configuration directory for the application as a C object. - -=cut - -sub config_home { - my $self = shift; - my $xdg = _home('config'); - return dir($xdg, $self->{name}); -} - -=head2 $xdg->cache_home() - -Returns the user-specific cache directory for the application as a C object. - -=cut - -sub cache_home { - my $self = shift; - my $xdg = _home('cache'); - return dir($xdg, $self->{name}); -} - -=head2 $xdg->data_dirs() - -Returns the system data directories, not modified for the application. Per the -specification, the returned string is :-delimited. - -=cut - -sub data_dirs { - return _dirs('data'); -} - -=head2 $xdg->config_dirs() - -Returns the system config directories, not modified for the application. Per -the specification, the returned string is :-delimited. - -=cut - -sub config_dirs { - return _dirs('config'); -} - -=head2 $xdg->lookup_data_file('subdir', 'filename'); - -Looks up the data file by searching for ./subdir/filename relative to all base -directories indicated by $XDG_DATA_HOME and $XDG_DATA_DIRS. If an environment -variable is either not set or empty, its default value as defined by the -specification is used instead. Returns a C object. - -=cut - -sub lookup_data_file { - my ($self, @subpath) = @_; - return $self->_lookup_file('data', @subpath); -} - -=head2 $xdg->lookup_config_file('subdir', 'filename'); - -Looks up the configuration file by searching for ./subdir/filename relative to -all base directories indicated by $XDG_CONFIG_HOME and $XDG_CONFIG_DIRS. If an -environment variable is either not set or empty, its default value as defined -by the specification is used instead. Returns a C object. - -=cut - -sub lookup_config_file { - my ($self, @subpath) = @_; - return $self->_lookup_file('config', @subpath); -} - -=head1 SEE ALSO - -L - -=head1 ACKNOWLEDGEMENTS - -This module's Windows support is made possible by C. I would also like to thank C and C. - -=head1 AUTHOR - -Kiyoshi Aman - -=cut - -1; diff --git a/perl5/ShellSequence.pm b/perl5/ShellSequence.pm deleted file mode 100644 index 7b07c798..00000000 --- a/perl5/ShellSequence.pm +++ /dev/null @@ -1,133 +0,0 @@ -package ShellSequence; - -use strict; -use warnings; - -use Capture::Tiny 'tee_stdout'; -use Array::Iterator; -use Term::UI; -use Term::ReadLine; -use ScriptStatus; - -sub new { - my $class = shift; - - my $self = { - 'commands' => [] - }; - bless $self, $class; - - return $self; -} - -# the advantage of using the add_ functions and queuing up commands is -# that the user will be informed what the next command will be, which -# helps them decide whether to give up and skip the command (e.g.: `mr -# autoci` is failing, and `mr push` will be next) - -sub add_should_zero { - my $self = shift; - my @args = @_; - - my $cmd = ['ZERO', @args]; - - push @{$self->{'commands'}}, $cmd; -} - -sub add_should_succeed { - my $self = shift; - my @args = @_; - - my $cmd = ['SUCCEED', @args]; - - push @{$self->{'commands'}}, $cmd; -} - -sub should_zero { - my $self = shift; - my @args = @_; - - $self->add_should_zero(@args); - $self->run(); -} - -sub should_succeed { - my $self = shift; - my @args = @_; - - $self->add_should_succeed(@args); - $self->run(); -} - -sub choice { - my $i = shift @_; - my @args = @_; - my $term = Term::ReadLine->new('brand'); - - - my $shell = $term->ask_yn( - prompt => 'Spawn a shell to investigate?', - default => 'n', - ); - if ($shell) { - status "I will try running `@args' again when this shell exits"; - system $ENV{'SHELL'}; - return 1; - } else { - if ($i->peek()) { - my @maybe_next = @{$i->peek()}; - shift @maybe_next; - my @next = @maybe_next; - status "info: if you skip, the next command will be `@next'"; - } - my $give_up = $term->ask_yn( - prompt => 'Give up and skip this command?', - default => 'n', - ); - return !$give_up; - } -} - -sub run { - my $self = shift; - - my $i = Array::Iterator->new($self->{'commands'}); - - while ( my $cmd = $i->get_next() ) { - my $require = shift @$cmd; - my @args = @$cmd; - - # previously we always used tee_stdout, and then looked at - # both $output and its exit code. However, tee_stdout works - # badly for ncurses, such as debconf prompts which appeared - # during apt runs. So don't use tee_stdout except when we - # have to - while (42) { - status "running `@args'"; - if ($require eq 'SUCCEED') { - system @args; - my $exit = $? >> 8; - if ($exit != 0) { - status "`@args' failed but it was required to succeed"; - choice($i, @args) || last; - } else { - last; - } - } else { - (my $output, undef) = tee_stdout { - system @args; - }; - if (length($output)) { - status "`@args' was required to produce no output"; - choice($i, @args) || last; - } else { - last; - } - } - } - } - - $self->{'commands'} = []; -} - -1; diff --git a/perl5/TestExec.pm b/perl5/TestExec.pm deleted file mode 100755 index cf7bcd86..00000000 --- a/perl5/TestExec.pm +++ /dev/null @@ -1,18 +0,0 @@ -#!/usr/bin/perl - -package TestExec; - -use strict; -use warnings; - -use Exporter; -our @ISA = ('Exporter'); -our @EXPORT = ('test_exec'); - -test_exec() unless caller(0); - -sub test_exec { - print "this is what I do\n"; -} - -1; -- cgit v1.2.3