r76540 - in /trunk/libterm-sk-perl: Build.PL Changes META.json META.yml README debian/changelog lib/Term/Sk.pm t/0010_test.t
mxey-guest at users.alioth.debian.org
mxey-guest at users.alioth.debian.org
Sat Jun 25 09:50:04 UTC 2011
Author: mxey-guest
Date: Sat Jun 25 09:49:55 2011
New Revision: 76540
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=76540
Log:
New upstream release
Modified:
trunk/libterm-sk-perl/Build.PL
trunk/libterm-sk-perl/Changes
trunk/libterm-sk-perl/META.json
trunk/libterm-sk-perl/META.yml
trunk/libterm-sk-perl/README
trunk/libterm-sk-perl/debian/changelog
trunk/libterm-sk-perl/lib/Term/Sk.pm
trunk/libterm-sk-perl/t/0010_test.t
Modified: trunk/libterm-sk-perl/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libterm-sk-perl/Build.PL?rev=76540&op=diff
==============================================================================
--- trunk/libterm-sk-perl/Build.PL (original)
+++ trunk/libterm-sk-perl/Build.PL Sat Jun 25 09:49:55 2011
@@ -5,7 +5,8 @@
use Module::Build;
Module::Build->new(
- module_name => 'Term::Sk',
- license => 'perl',
- dist_abstract => 'Perl extension for displaying a progress indicator on a terminal',
+ module_name => 'Term::Sk',
+ license => 'perl',
+ configure_requires => { 'Module::Build' => 0.30 },
+ dist_abstract => 'Perl extension for displaying a progress indicator on a terminal',
)->create_build_script;
Modified: trunk/libterm-sk-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libterm-sk-perl/Changes?rev=76540&op=diff
==============================================================================
--- trunk/libterm-sk-perl/Changes (original)
+++ trunk/libterm-sk-perl/Changes Sat Jun 25 09:49:55 2011
@@ -47,3 +47,11 @@
after : This option allows one to register...
Make subs log_info(), set_chunk_size() and set_bkup_size() effectively dummy operations (i.e. they
don't have any effect whatsoever)
+
+0.09 21 Jun 2011
+ refactor/simplify subroutine rem_backspace().
+ refactor/simplify time recording (subroutine show_maybe())
+ in subroutine token(): replace $self->up; by $self->show_maybe;
+ add some more tests
+ add initialiser 'mock_tm' and method mock_time() to mock time for testing
+ add configure_requires => { 'Module::Build' => 0.30 } to Build.PL
Modified: trunk/libterm-sk-perl/META.json
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libterm-sk-perl/META.json?rev=76540&op=diff
==============================================================================
--- trunk/libterm-sk-perl/META.json (original)
+++ trunk/libterm-sk-perl/META.json Sat Jun 25 09:49:55 2011
@@ -16,14 +16,14 @@
"prereqs" : {
"configure" : {
"requires" : {
- "Module::Build" : "0.38"
+ "Module::Build" : "0.3"
}
}
},
"provides" : {
"Term::Sk" : {
"file" : "lib/Term/Sk.pm",
- "version" : "0.08"
+ "version" : "0.09"
}
},
"release_status" : "stable",
@@ -32,5 +32,5 @@
"http://dev.perl.org/licenses/"
]
},
- "version" : "0.08"
+ "version" : "0.09"
}
Modified: trunk/libterm-sk-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libterm-sk-perl/META.yml?rev=76540&op=diff
==============================================================================
--- trunk/libterm-sk-perl/META.yml (original)
+++ trunk/libterm-sk-perl/META.yml Sat Jun 25 09:49:55 2011
@@ -4,7 +4,7 @@
- unknown
build_requires: {}
configure_requires:
- Module::Build: 0.38
+ Module::Build: 0.3
dynamic_config: 1
generated_by: 'Module::Build version 0.38, CPAN::Meta::Converter version 2.110930'
license: perl
@@ -15,7 +15,7 @@
provides:
Term::Sk:
file: lib/Term/Sk.pm
- version: 0.08
+ version: 0.09
resources:
license: http://dev.perl.org/licenses/
-version: 0.08
+version: 0.09
Modified: trunk/libterm-sk-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libterm-sk-perl/README?rev=76540&op=diff
==============================================================================
--- trunk/libterm-sk-perl/README (original)
+++ trunk/libterm-sk-perl/README Sat Jun 25 09:49:55 2011
@@ -1,4 +1,4 @@
-Term-Sk Version 0.08
+Term-Sk Version 0.09
This is a Perl extension for displaying a progress indicator on a terminal.
Modified: trunk/libterm-sk-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libterm-sk-perl/debian/changelog?rev=76540&op=diff
==============================================================================
--- trunk/libterm-sk-perl/debian/changelog (original)
+++ trunk/libterm-sk-perl/debian/changelog Sat Jun 25 09:49:55 2011
@@ -1,3 +1,9 @@
+libterm-sk-perl (0.09-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- Maximilian Gass <mxey at cloudconnected.org> Sat, 25 Jun 2011 11:49:18 +0200
+
libterm-sk-perl (0.08-1) unstable; urgency=low
* Team upload.
Modified: trunk/libterm-sk-perl/lib/Term/Sk.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libterm-sk-perl/lib/Term/Sk.pm?rev=76540&op=diff
==============================================================================
--- trunk/libterm-sk-perl/lib/Term/Sk.pm (original)
+++ trunk/libterm-sk-perl/lib/Term/Sk.pm Sat Jun 25 09:49:55 2011
@@ -16,7 +16,7 @@
our @EXPORT = qw();
-our $VERSION = '0.08';
+our $VERSION = '0.09';
our $errcode = 0;
our $errmsg = '';
@@ -41,6 +41,7 @@
$self->{format} = $format;
$self->{freq} = $hash{freq};
$self->{value} = $hash{base};
+ $self->{mock_tm} = $hash{mock_tm};
$self->{oldtext} = '';
$self->{line} = '';
$self->{pdisp} = '#';
@@ -111,12 +112,18 @@
$self->{tick} = 0;
$self->{out} = 0;
- $self->{sec_begin} = int(time * 100);
- $self->{sec_print} = $self->{sec_begin};
+ $self->{sec_begin} = $self->{mock_tm} ? $self->{mock_tm} : time;
+ $self->{sec_print} = 0;
$self->show;
return $self;
+}
+
+sub mock_time {
+ my $self = shift;
+
+ $self->{mock_tm} = $_[0];
}
sub whisper {
@@ -150,7 +157,7 @@
sub ticks { my $self = shift; return $self->{tick} }
-sub token { my $self = shift; $self->{token} = shift; $self->up }
+sub token { my $self = shift; $self->{token} = shift; $self->show_maybe; }
sub DESTROY {
my $self = shift;
@@ -162,19 +169,19 @@
$self->{line} = '';
- my $sec_now = int(time * 100);
+ my $sec_now = ($self->{mock_tm} ? $self->{mock_tm} : time) - $self->{sec_begin};
my $sec_prev = $self->{sec_print};
$self->{sec_print} = $sec_now;
$self->{tick}++;
if ($self->{freq} eq 's') {
- if (int($sec_prev / 100) != int($sec_now / 100)) {
+ if (int($sec_prev) != int($sec_now)) {
$self->show;
}
}
elsif ($self->{freq} eq 'd') {
- if (int($sec_prev / 10) != int($sec_now / 10)) {
+ if (int($sec_prev * 10) != int($sec_now * 10)) {
$self->show;
}
}
@@ -205,7 +212,7 @@
next;
}
if ($type eq 't') { # print (= append to $text) time elapsed in format 'hh:mm:ss'
- my $unit = int(($self->{sec_print} - $self->{sec_begin}) / 100);
+ my $unit = int($self->{sec_print});
my $hour = int($unit / 3600);
my $min = int(($unit % 3600) / 60);
my $sec = $unit % 60;
@@ -301,28 +308,14 @@
while (read($ifh, my $inp_buf, $chunk_size)) {
$out_buf .= $inp_buf;
- my $log_input = length($inp_buf);
-
- my $log_backspaces = 0;
+
# here we are removing the backspaces:
while ($out_buf =~ m{\010+}xms) {
- # $& is the same as substr($out_buf, $-[0], $+[0] - $-[0])
- my ($pos_from, $pos_to) = ($-[0], $+[0]);
- $log_backspaces += $pos_to - $pos_from;
-
- my ($underflow, $pos_left);
- if ($pos_from * 2 >= $pos_to) {
- $underflow = 0;
- $pos_left = $pos_from * 2 - $pos_to;
- }
- else {
- $underflow = 1;
- $pos_left = 0;
- }
-
- my $delstr = substr($out_buf, $pos_left, $pos_from - $pos_left);
-
- $out_buf = substr($out_buf, 0, $pos_left).substr($out_buf, $pos_to);
+ my $pos_left = $-[0] * 2 - $+[0];
+ if ($pos_left < 0) {
+ $pos_left = 0;
+ }
+ $out_buf = substr($out_buf, 0, $pos_left).substr($out_buf, $+[0]);
}
if (length($out_buf) > $bkup_size) {
@@ -347,6 +340,7 @@
}
1;
+
__END__
=head1 NAME
@@ -622,7 +616,7 @@
use Term::Sk qw(rem_backspace);
- my $flatfile = "Test hijabc\010\010\010xyzklm";
+ my $flatfile = "Test hijabc\010\010\010xyzklmttt\010\010yzz";
printf "before (len=%3d): '%s'\n", length($flatfile), $flatfile;
Modified: trunk/libterm-sk-perl/t/0010_test.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libterm-sk-perl/t/0010_test.t?rev=76540&op=diff
==============================================================================
--- trunk/libterm-sk-perl/t/0010_test.t (original)
+++ trunk/libterm-sk-perl/t/0010_test.t Sat Jun 25 09:49:55 2011
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 57;
+use Test::More tests => 67;
use_ok('Term::Sk');
@@ -178,14 +178,56 @@
{
my $ctr = Term::Sk->new('Token %6k Ctr %c', { test => 1, base => 1, token => 'Spain' } );
ok(defined($ctr), 'Test-0610: %6k %c works ok');
- is(content($ctr->get_line), q{Token Spain Ctr 1}, 'Test-0620: first Token displayed correctly');
+ is(content($ctr->get_line), q{Token Spain Ctr 1}, 'Test-0620: first Token displayed correctly');
$ctr->token('USA');
- is(content($ctr->get_line), q{Token USA Ctr 2}, 'Test-0630: second Token displayed correctly');
+ is(content($ctr->get_line), q{Token USA Ctr 1}, 'Test-0630: second Token displayed correctly');
+}
+
+{
+ # mock-time = Tue Jun 21 14:21:02-28 2011
+ my $ctr = Term::Sk->new('Time %8t Ctr %c', { test => 1, base => 3, mock_tm => 1308658862.287032} );
+ ok(defined($ctr), 'Test-0640: %8t %c works ok');
+ is(content($ctr->get_line), q{Time 00:00:00 Ctr 3}, 'Test-0650: first Time displayed correctly');
+ # mock-time = Tue Jun 21 14:29:37-53 2011
+ $ctr->mock_time(1308659377.534502);
+ $ctr->up;
+ is(content($ctr->get_line), q{Time 00:08:35 Ctr 4}, 'Test-0660: second Time displayed correctly');
+}
+
+{
+ # mock-time = Tue Jun 21 14:21:02-28 2011
+ my $ctr = Term::Sk->new('Time %8t %d Ctr %c', { test => 1, base => 2, mock_tm => 1308658862.287032} );
+ ok(defined($ctr), 'Test-0670: %8t %d %c works ok');
+ is(content($ctr->get_line), q{Time 00:00:00 - Ctr 2}, 'Test-0680: first Time displayed correctly');
+ # mock-time = Tue Jun 21 14:21:02-29 2011
+ $ctr->mock_time(1308658862.291483);
+ $ctr->up;
+ is(content($ctr->get_line), q{Time 00:00:00 \ Ctr 3}, 'Test-0690: second Time displayed, dash has not changed');
+ # mock-time = Tue Jun 21 14:21:02-32 2011
+ $ctr->mock_time(1308658862.323717);
+ $ctr->up;
+ is(content($ctr->get_line), q{Time 00:00:00 | Ctr 4}, 'Test-0700: third Time displayed, dash has changed');
+ # mock-time = Tue Jun 21 14:21:03-29 2011
+ $ctr->mock_time(1308658863.2911543);
+ $ctr->up;
+ is(content($ctr->get_line), q{Time 00:00:01 / Ctr 5}, 'Test-0710: fourth Time displayed, Time and dash have changed');
+}
+
+{
+ my $flatfile = "Test hijabc\010\010\010xyzklmttt\010\010yzz";
+
+ (my $disp_before = $flatfile) =~ s{\010}'<'xmsg;
+ is($disp_before, q{Test hijabc<<<xyzklmttt<<yzz}, 'Test-0720: before rem_backspace');
+
+ Term::Sk::rem_backspace(\$flatfile);
+
+ (my $disp_after = $flatfile) =~ s{\010}'<'xmsg;
+ is($disp_after, q{Test hijxyzklmtyzz}, 'Test-0730: after rem_backspace');
}
sub content {
my ($text) = @_;
- $text =~ s{^ \010+ \s+ \010+}{}xms;
+ $text =~ s{^ \010+ \s+ \010+}{}xmsg;
return $text;
}
More information about the Pkg-perl-cvs-commits
mailing list