minor archive out of bin/ and perl5/

6 files changed, 461 insertions, 0 deletions

diff --git a/archive/bin/spw.py b/archive/bin/spw.py
new file mode 100644
index 00000000..ce4a219f
--- /dev/null
+++ b/archive/bin/spw.py
@@ -0,0 +1,65 @@
+"""Sean's helper functions for python scripts in ~/bin"""
+
+import termios
+import fcntl
+import subprocess
+import sys
+import os
+
+def try_audible_notification(text):
+    """Try to send a notification and play a sound.  Don't do anything if
+    can't.
+
+    """
+    dev_null = open('/dev/null', 'w')
+    try:
+        subprocess.Popen(['/usr/bin/notify-send',
+                          '--hint=int:transient:1',
+                          text], stderr=dev_null, env=os.environ)
+        audio_file = os.path.expanduser('~/lib/annex/doc/sounds/beep.wav')
+        subprocess.call(['/usr/bin/aplay', audio_file], stderr=dev_null)
+    except OSError:
+        pass
+    except subprocess.CalledProcessError:
+        pass
+    dev_null.close()
+
+def print_same_line(line=''):
+    """Print and then carriage return to stay on the same line"""
+    # First clear to end of line: then if last print called this
+    # function so cursor is at beginning of line, it'll clear out
+    # previous printed string.  Needed in case current line is shorter
+    # than previous one
+    sys.stdout.write("\033[K")
+
+    sys.stdout.write(line + '\r')
+    sys.stdout.flush()
+
+# TODO: better: http://stackoverflow.com/a/6599414
+# avoids spinning in a tight loop making the CPU run wild
+def getch():
+    """Get a single char from the keyboard without curses library.  From
+    the Python manual's Library and Extension FAQ
+
+    """
+    fileno = sys.stdin.fileno()
+
+    oldterm = termios.tcgetattr(fileno)
+    newattr = termios.tcgetattr(fileno)
+    newattr[3] = newattr[3] & ~termios.ICANON & ~termios.ECHO
+    termios.tcsetattr(fileno, termios.TCSANOW, newattr)
+
+    oldflags = fcntl.fcntl(fileno, fcntl.F_GETFL)
+    fcntl.fcntl(fileno, fcntl.F_SETFL, oldflags | os.O_NONBLOCK)
+
+    try:
+        while 1:
+            try:
+                the_char = sys.stdin.read(1)
+                break
+            except IOError:
+                pass
+    finally:
+        termios.tcsetattr(fileno, termios.TCSAFLUSH, oldterm)
+        fcntl.fcntl(fileno, fcntl.F_SETFL, oldflags)
+    return the_char
diff --git a/archive/bin/test-exec b/archive/bin/test-exec
new file mode 120000
index 00000000..2b09490d
--- /dev/null
+++ b/archive/bin/test-exec
@@ -0,0 +1 @@
+../lib/perl5/TestExec.pm
\ No newline at end of file
diff --git a/archive/bin/test-import b/archive/bin/test-import
new file mode 100755
index 00000000..85176abb
--- /dev/null
+++ b/archive/bin/test-import
@@ -0,0 +1,7 @@
+#!/usr/bin/perl
+
+use lib "$ENV{HOME}/src/dotfiles/perl5";
+
+use TestExec;
+
+test_exec();
diff --git a/archive/perl5/File/XDG.pm b/archive/perl5/File/XDG.pm
new file mode 100644
index 00000000..30dc672e
--- /dev/null
+++ b/archive/perl5/File/XDG.pm
@@ -0,0 +1,237 @@
+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<File::XDG> - 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<File::XDG> object. This must be called with an
+application name as the C<name> 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<Path::Class> 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<Path::Class> 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<Path::Class> 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<Path::Class> 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<Path::Class> object.
+
+=cut
+
+sub lookup_config_file {
+    my ($self, @subpath) = @_;
+    return $self->_lookup_file('config', @subpath);
+}
+
+=head1 SEE ALSO
+
+L<XDG Base Directory specification, version 0.7|http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html>
+
+=head1 ACKNOWLEDGEMENTS
+
+This module's Windows support is made possible by C<File::HomeDir>. I would also like to thank C<Path::Class> and C<File::Spec>.
+
+=head1 AUTHOR
+
+Kiyoshi Aman <kiyoshi.aman@gmail.com>
+
+=cut
+
+1;
diff --git a/archive/perl5/ShellSequence.pm b/archive/perl5/ShellSequence.pm
new file mode 100644
index 00000000..7b07c798
--- /dev/null
+++ b/archive/perl5/ShellSequence.pm
@@ -0,0 +1,133 @@
+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/archive/perl5/TestExec.pm b/archive/perl5/TestExec.pm
new file mode 100755
index 00000000..cf7bcd86
--- /dev/null
+++ b/archive/perl5/TestExec.pm
@@ -0,0 +1,18 @@
+#!/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;