# HG changeset patch
# User Matthias Förste <foerste@schlittermann.de>
# Date 1487169833 -3600
# Node ID 8af91c021f4a69c62c826553a91d3db74c3f71b1
# Parent  531e14cda4fa7b83d5af568e82305c56129afa27
moved to git

diff -r 531e14cda4fa -r 8af91c021f4a README
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/README	Wed Feb 15 15:43:53 2017 +0100
@@ -0,0 +1,1 @@
+moved to git
diff -r 531e14cda4fa -r 8af91c021f4a purge-proe
--- a/purge-proe	Thu Jul 23 15:57:20 2015 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,127 +0,0 @@
-#!/usr/bin/perl
-
-#    Delete old Pro/Engineer files
-#    Copyright (C) 2010-2015 Matthias Förste
-#
-#    This program is free software: you can redistribute it and/or modify
-#    it under the terms of the GNU General Public License as published by
-#    the Free Software Foundation, either version 3 of the License, or
-#    (at your option) any later version.
-#
-#    This program is distributed in the hope that it will be useful,
-#    but WITHOUT ANY WARRANTY; without even the implied warranty of
-#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-#    GNU General Public License for more details.
-#
-#    You should have received a copy of the GNU General Public License
-#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
-#
-#    Matthias Förste <foerste@schlittermann.de>
-
-use strict;
-use warnings;
-
-use Getopt::Long;
-use Pod::Usage;
-use File::Find;
-use File::Basename;
-
-my $files;
-my $opt = {
-
-  dirs => [],   # dont set default dir here because arguments to --directory will
-                # not overwrite it, but added to it
-  keep => 3
-
-};
-
-my $proe_first_line = "#UGC:";
-my $proe_stems = [qw(errors.lst support.inf trail.txt test.txt global_intf.inf outdated.lst outdated.err info.trf)];
-
-die "Failed to read options" unless GetOptions(
-  'directory=s' => $opt->{dirs},
-  'help' => sub { pod2usage(-verbose => 1, -exitval => 0) },
-  'man' => sub { pod2usage(-verbose => 2, -exitval => 0) },
-  'keep=i' => \$opt->{keep},
-);
-
-sub doit {
-
-  return if -d;
-
-  my $f = $File::Find::name;
-  return unless $f =~ /^(.+)\.([0-9]+)$/;
-
-  my ($stem, $stembase, $suffix) = ($1, basename($1), $2);
-
-  eval {
-
-    for (@{$proe_stems}) { return if $stembase eq $_; }
-    die "Ignoring '$f': is empty" unless -s $f;
-    die "Ignoring '$f': failed to open: $!" unless open FILE, '<', $f;
-    # should only happen in case of a read error because we already
-    # checked the file for emptiness
-    die "Ignoring '$f': failed to read: $!" unless defined ($_ = <FILE>);
-    die "Ignoring '$f': not an Pro/Engineerfile" unless /^$proe_first_line/;
-
-  };
-
-  warn $@ and return if $@ ne '';
-  $files->{$stem} = exists $files->{$stem} ? [ $suffix, @{$files->{$stem}} ] : [ $suffix ];
-
-}
-
-$opt->{dirs} = ['.'] unless @{$opt->{dirs}};
-
-find( { wanted => \&doit, no_chdir => 1 }, @{$opt->{dirs}});
-my @sufs;
-for my $stem (keys %{$files}) {
-
-  @sufs = sort { $a <=> $b } @{$files->{$stem}};
-
-  my $to = $#sufs - $opt->{keep};
-  my $from;
-  if ($to < 0) { $from = 0; } else { $from = $to + 1; }
-
-  for (@sufs[0 .. $to]) {
-    print "Going to delete $stem.$_\n";
-    warn "Couldn't unlink: $stem.$_: $!" unless unlink "$stem.$_";
-  }
-
-  for (@sufs[$from .. $#sufs]) {
-    print "Going to keep $stem.$_\n";
-  }
-
-}
-
-=head1 NAME
-
-purge-proe - delete old Pro/Engineer files
-
-=head1 SYNOPSIS
-
-purge-proe [-d|--directory directory1] [-d|--directory directory2] ...
-           [-k|--keep n]
-
-purge-proe [-h|--help]
-
-purge-proe [-m|--man]
-
-=head1 OPTIONS
-
-=over
-
-=item B<-d>|B<--directory> directory
-
-A directory to clean. This option can be given multiple times. (default:
-current directory)
-
-=item B<-k>|B<--keep n>
-
-Number of old files to keep. (default: 3)
-
-=back
-
-=head1 BUGS
-
-Probably.
diff -r 531e14cda4fa -r 8af91c021f4a test
--- a/test	Thu Jul 23 15:57:20 2015 +0200
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,81 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-my $purge_cmd = "./purge-proe";
-
-my $stem = "a";
-my $subdir = "x";
-my $proe_first_line = "#UGC:";
-my $num_empty = 69;
-my $num_non_proe = 101;
-my @nums_before = (0, 1, 2, 7, 13, 17, 23, 42, '0815', 4711);
-
-use Test::Simple tests => 53;
-
-my $files = {
-
-  in_workdir => [ map "$stem.$_", @nums_before ],
-  in_subdir => [ map "$subdir/$stem.$_", @nums_before ],
-  empty => "$subdir/$stem.$num_empty",
-  non_proe => "$subdir/$stem.$num_non_proe",
-  errors_lst => [ map "errors.lst.$_", @nums_before ],
-  trail_txt => [ map "trail.txt.$_", @nums_before ],
-  info_trf => [ map "info.trf.$_", @nums_before ]
-
-};
-
-sub prepare;
-
-prepare({ dirs => [$subdir], files => $files, proe_first_line => $proe_first_line });
-ok(qx/$purge_cmd/, "Running '$purge_cmd'");
-my (@absent, @present);
-@present = @{$files}{qw(empty non_proe)};
-for (qw(in_workdir in_subdir errors_lst trail_txt info_trf)) {
-    push @present, splice @{$files->{$_}}, -3, 3;
-    push @absent, @{$files->{$_}};
-}
-for (@present) { ok(-f $_, "Checking for presence of file '$_'"); }
-for (@absent) { ok(! -e $_, "Checking for absence of '$_'"); }
-
-for (@present, "y/abc") { unlink || warn "Can't unlink '$_': $!" if -f; }
-rmdir $subdir or warn "Can't rmdir '$subdir': $!";
-
-# $opts = { 
-#   dirs => ['dir1', 'dir2', ..],
-#   files => {
-#     in_workdir => ['file1', 'file2', ..],
-#     in_subdir => ['path1', 'path2', ..],
-#     empty => 'path_to_an_empty_file',
-#     non_proe => 'path_to_a_nonempty_nonproe_file'
-#     errors_lst => [ 'errors.lst.n1', 'errors.lst.n2', ..],
-#     trail_txt => [ 'trail.txt.n1', 'trail.txt.n2', ..],
-#     info_trf => [ 'info.trf.n1', 'info.trf.n2', ..]
-#   },
-#   proe_first_line => 'something that should appear in the first line of a file to match'
-# }
-sub prepare {
-
-  my ($opts) = @_;
-
-  for (@{$opts->{dirs}}) { mkdir $_ or warn "Can't mkdir '$_': $!"; }
-
-  for (map { @{$_} } @{$opts->{files}}{qw(in_workdir in_subdir errors_lst trail_txt info_trf)}) {
-
-      open F, '>', $_ or warn "Can't open F, '>', '$_': $!";
-      print F $proe_first_line;
-      close F;
-
-  }
-
-  my $empty = $opts->{files}->{empty};
-  open F, '>', $empty or warn "Can't open F, '>', '$empty': $!";
-  close F;
-
-  my $non_proe = $opts->{files}->{non_proe};
-  open F, '>', $non_proe or warn "Can't open F, '>', '$non_proe': $!";
-  print F "foo";
-  close F;
-
-}