r58064 - in /branches/upstream/libticket-simple-perl: ./ current/ current/lib/ current/lib/Ticket/ current/t/
xoswald at users.alioth.debian.org
xoswald at users.alioth.debian.org
Wed May 19 12:36:04 UTC 2010
Author: xoswald
Date: Wed May 19 12:35:53 2010
New Revision: 58064
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=58064
Log:
[svn-inject] Installation de la source initiale de libticket-simple-perl
Added:
branches/upstream/libticket-simple-perl/
branches/upstream/libticket-simple-perl/current/
branches/upstream/libticket-simple-perl/current/Build.PL
branches/upstream/libticket-simple-perl/current/Changes
branches/upstream/libticket-simple-perl/current/MANIFEST
branches/upstream/libticket-simple-perl/current/MANIFEST.SKIP
branches/upstream/libticket-simple-perl/current/META.yml
branches/upstream/libticket-simple-perl/current/Makefile.PL
branches/upstream/libticket-simple-perl/current/README
branches/upstream/libticket-simple-perl/current/lib/
branches/upstream/libticket-simple-perl/current/lib/Ticket/
branches/upstream/libticket-simple-perl/current/lib/Ticket/Simple.pm
branches/upstream/libticket-simple-perl/current/t/
branches/upstream/libticket-simple-perl/current/t/00.load.t
branches/upstream/libticket-simple-perl/current/t/10.init_tests.t
branches/upstream/libticket-simple-perl/current/t/20_now.t
branches/upstream/libticket-simple-perl/current/t/21_create_ticket.t
branches/upstream/libticket-simple-perl/current/t/22_store_ticket.t
branches/upstream/libticket-simple-perl/current/t/23_fetch_ticket.t
branches/upstream/libticket-simple-perl/current/t/24_is_ticket_equal_stored.t
branches/upstream/libticket-simple-perl/current/t/25_is_ticket_valid.t
branches/upstream/libticket-simple-perl/current/t/26_ttl.t
branches/upstream/libticket-simple-perl/current/t/27_wipe_ticket.t
branches/upstream/libticket-simple-perl/current/t/28_destroy_ticket.t
branches/upstream/libticket-simple-perl/current/t/29_is_ticket_valid_now.t
branches/upstream/libticket-simple-perl/current/t/leaktrace.t
branches/upstream/libticket-simple-perl/current/t/perlcritic_cpan.t
branches/upstream/libticket-simple-perl/current/t/perlcriticrc
branches/upstream/libticket-simple-perl/current/t/pod-coverage.t
branches/upstream/libticket-simple-perl/current/t/pod.t
branches/upstream/libticket-simple-perl/current/t/refcount.t
Added: branches/upstream/libticket-simple-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/Build.PL?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/Build.PL (added)
+++ branches/upstream/libticket-simple-perl/current/Build.PL Wed May 19 12:35:53 2010
@@ -1,0 +1,52 @@
+use strict;
+use warnings;
+use Module::Build;
+
+my $builder = Module::Build->new(
+ module_name => 'Ticket::Simple',
+ license => 'gpl2',
+ dist_author => 'Christian Kuelker <christian.kuelker at cipworx.org>',
+ dist_version => '0.0.2',
+ dist_abstract => 'A basic ticket system',
+
+ # create_makefile_pl => 'traditional',
+ # create_readme => 1,
+ # verbose => 1,
+ installdirs => 'vendor',
+
+ meta_merge => { resources => { homepage => q(http://www.cipux.org), }, },
+
+ recommends => {
+
+ 'Test::Perl::Critic' => 0,
+ 'Test::Pod::Coverage' => '1.04',
+ },
+
+ build_requires => {
+ 'Module::Build' => 0,
+
+ 'Test::More' => 0,
+ 'Test::Pod' => '1.14',
+ },
+
+ requires => {
+ 'Carp' => 0,
+ 'Class::Std' => '0.0.9',
+
+ #'Contextual::Return' => 0,
+ #'Date::Manip' => 0,
+ 'Digest::MD5' => 0,
+ 'Log::Log4perl' => 0,
+ 'Readonly' => 0,
+ 'Time::HiRes' => 0,
+ 'version' => 0,
+
+ },
+
+ add_to_cleanup => ['Ticket-Simple-*'],
+);
+
+# BUILD target
+#$builder->do_create_readme();
+#$builder->do_create_makefile_pl();
+$builder->create_build_script();
Added: branches/upstream/libticket-simple-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/Changes?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/Changes (added)
+++ branches/upstream/libticket-simple-perl/current/Changes Wed May 19 12:35:53 2010
@@ -1,0 +1,22 @@
+Revision history for Ticket-Simple
+
+0.0.2 2010-04-01T17:01:21
+
+ - changes:
+ * tighten licence specification to make META.yml happy
+ * add descr. to POD NAME section to avoid lintian warning
+
+ - contributers:
+ Christian Kuelker <christian.kuelker at cipworx.org>
+ Xavier Oswald <xoswald at debian.org> Lintian warnings
+
+ - original version createid by:
+ Christian Kuelker <christian.kuelker at cipworx.org>
+
+0.0.l 2009-11-29T10:08:22
+
+ - contributers:
+ Christian Kuelker <christian.kuelker at cipworx.org>
+
+ - original version createid by:
+ Christian Kuelker <christian.kuelker at cipworx.org>
Added: branches/upstream/libticket-simple-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/MANIFEST?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/MANIFEST (added)
+++ branches/upstream/libticket-simple-perl/current/MANIFEST Wed May 19 12:35:53 2010
@@ -1,0 +1,26 @@
+Build.PL
+Changes
+lib/Ticket/Simple.pm
+Makefile.PL
+MANIFEST This list of files
+MANIFEST.SKIP
+META.yml
+README
+t/00.load.t
+t/10.init_tests.t
+t/20_now.t
+t/21_create_ticket.t
+t/22_store_ticket.t
+t/23_fetch_ticket.t
+t/24_is_ticket_equal_stored.t
+t/25_is_ticket_valid.t
+t/26_ttl.t
+t/27_wipe_ticket.t
+t/28_destroy_ticket.t
+t/29_is_ticket_valid_now.t
+t/leaktrace.t
+t/perlcritic_cpan.t
+t/perlcriticrc
+t/pod-coverage.t
+t/pod.t
+t/refcount.t
Added: branches/upstream/libticket-simple-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/MANIFEST.SKIP?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libticket-simple-perl/current/MANIFEST.SKIP Wed May 19 12:35:53 2010
@@ -1,0 +1,47 @@
+
+#!start included /usr/local/share/perl/5.10.0/ExtUtils/MANIFEST.SKIP
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\B\.git\b
+\B\.gitignore\b
+\b_darcs\b
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$ # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+
+# Avoid Devel::Cover files.
+\bcover_db\b
+#!end included /usr/local/share/perl/5.10.0/ExtUtils/MANIFEST.SKIP
+
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\bBuild.bat$
+\b_build
+\bBuild.COM$
+\bBUILD.COM$
+\bbuild.com$
+
+# Avoid archives of this distribution
+\bTicket-Simple-[\d\.\_]+
Added: branches/upstream/libticket-simple-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/META.yml?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/META.yml (added)
+++ branches/upstream/libticket-simple-perl/current/META.yml Wed May 19 12:35:53 2010
@@ -1,0 +1,35 @@
+---
+name: Ticket-Simple
+version: v0.0.2
+author:
+ - 'Christian Kuelker <christian.kuelker at cipworx.org>'
+abstract: A basic ticket system
+license: gpl2
+resources:
+ homepage: http://www.cipux.org
+ license: http://opensource.org/licenses/gpl-2.0.php
+build_requires:
+ Module::Build: 0
+ Test::More: 0
+ Test::Pod: 1.14
+requires:
+ Carp: 0
+ Class::Std: v0.0.9
+ Digest::MD5: 0
+ Log::Log4perl: 0
+ Readonly: 0
+ Time::HiRes: 0
+ version: 0
+recommends:
+ Test::Perl::Critic: 0
+ Test::Pod::Coverage: 1.04
+configure_requires:
+ Module::Build: 0.35
+provides:
+ Ticket::Simple:
+ file: lib/Ticket/Simple.pm
+ version: v0.0.2
+generated_by: Module::Build version 0.35
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Added: branches/upstream/libticket-simple-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/Makefile.PL?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/Makefile.PL (added)
+++ branches/upstream/libticket-simple-perl/current/Makefile.PL Wed May 19 12:35:53 2010
@@ -1,0 +1,3 @@
+use Module::Build::Compat;
+Module::Build::Compat->run_build_pl(args => \@ARGV);
+Module::Build::Compat->write_makefile();
Added: branches/upstream/libticket-simple-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/README?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/README (added)
+++ branches/upstream/libticket-simple-perl/current/README Wed May 19 12:35:53 2010
@@ -1,0 +1,32 @@
+Ticket-Simple version 0.0.1
+
+ A basic ticket system
+
+
+INSTALLATION
+
+To install this module, preferably run the following commands:
+
+ perl Build.PL
+ ./Build
+ ./Build test
+ ./Build install
+
+
+DEPENDENCIES
+
+ Carp;
+ Class::Std
+ Digest::MD5
+ Log::Log4perl
+ Readonly
+ Time::HiRes
+ version
+
+COPYRIGHT AND LICENCE
+
+Copyright (C) 2009, Christian Kuelker
+
+ This library is licensed under the GNU GPL - GNU General Public License
+ version 2 or later.
+
Added: branches/upstream/libticket-simple-perl/current/lib/Ticket/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/lib/Ticket/Simple.pm?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/lib/Ticket/Simple.pm (added)
+++ branches/upstream/libticket-simple-perl/current/lib/Ticket/Simple.pm Wed May 19 12:35:53 2010
@@ -1,0 +1,384 @@
+# +=========================================================================+
+# || Ticket::Simple ||
+# || A basic ticket system ||
+# +=========================================================================+
+# Id: $Id$
+# Rev: $Revision$
+# Source: $Source$
+# Date: $Date$
+# URL: $HeadURL$
+
+package Ticket::Simple;
+
+use strict;
+use warnings;
+use Carp qw(confess);
+use Class::Std;
+use Digest::MD5 qw(md5_hex);
+use Log::Log4perl qw(get_logger :levels);
+use Readonly;
+use Time::HiRes qw(gettimeofday);
+
+{ # begin insite out class
+
+ # PRIVATE METHODS
+ # - seed
+ # PUBLIC METHODS
+ # - create_ticket
+
+ use version; our $VERSION = qv('v0.0.2');
+ use re 'taint'; # Keep data captured by parens tainted
+ delete @ENV{qw(PATH IFS CDPATH ENV BASH_ENV)}; # Make %ENV safe
+
+ # CONST
+ Readonly::Scalar my $EMPTY_STRING => q{};
+ Readonly::Scalar my $TICKET_LENGTH => 32;
+ Readonly::Scalar my $SEED_LENGTH => 1282;
+ Readonly::Array my @RND_SEED_CHARS =>
+ ( 'A' .. 'Z', 'a' .. 'z', 0 .. 9, qw(! @ $ % &) );
+ Readonly::Scalar my $SEED => seed();
+ Readonly::Scalar my $TTL => 600; # in sec
+
+ # OBJ
+ ## no critic
+ my %ttl_of : ATTR( init_arg =>'ttl' :get<ttl> :set<ttl> :default(600));
+
+ # GLOBAL
+ my %cred = ();
+
+ # define a closure for log4perl
+ my $ifdef = sub {
+ my $v = shift;
+ return sub { return $v if defined $v; return 'UNDEF'; };
+ };
+
+ sub now {
+
+ my ( $self, $p_r ) = @_;
+ my $l = get_logger(__PACKAGE__);
+
+ my ( $seconds, $microseconds ) = gettimeofday;
+ $l->debug("time now [$seconds] seconds");
+ $l->debug("time now [$microseconds] micro-seconds");
+
+ my $now = "$seconds.$microseconds";
+ $l->debug("time now [$now] time");
+
+ return $now;
+ }
+
+ sub create_ticket {
+
+ my ( $self, $p_r ) = @_;
+ my $msg = 'parameter [login] is missing in sub call [create_ticket]';
+ my $login = exists $p_r->{login} ? $p_r->{login} : confess $msg;
+ my $time = exists $p_r->{time} ? $p_r->{time} : $self->now;
+
+ my $l = get_logger(__PACKAGE__);
+
+ # prepare
+ $l->debug("input parameter login: [$login]");
+ $l->debug("global parameter SEED: [$SEED]");
+
+ my $ttl
+ = ( exists $ttl_of{ ident $self}
+ and defined > $ttl_of{ ident $self}
+ and $ttl_of{ ident $self} > 0 )
+ ? $ttl_of{ ident $self}
+ : $TTL;
+ $l->debug( 'ttl: ', $ttl );
+
+ # main
+ my ( $seconds, $microseconds ) = split m{\.}mx, $time;
+ $l->debug("time [$seconds] seconds");
+ $l->debug("time [$seconds] micro-seconds");
+ my $valid = $seconds + $ttl . ".$microseconds";
+ $l->debug("valid until [$valid] seconds.micro-seconds");
+
+ my $ticket = md5_hex( join $EMPTY_STRING, $valid, $SEED, $login );
+ $l->info("new ticket [$ticket]");
+
+ return ( $ticket, $valid );
+ }
+
+ sub wipe_ticket {
+
+ my ( $self, $p_r ) = @_;
+ my $msg = 'parameter [login] is missing in sub call [wipe_ticket]';
+ my $login = exists $p_r->{login} ? $p_r->{login} : confess $msg;
+
+ $self->store_ticket(
+ { login => $login, ticket => $EMPTY_STRING, valid => 0 } );
+
+ return 1;
+
+ }
+
+ sub destroy_ticket {
+
+ my ( $self, $p_r ) = @_;
+ my $msg = 'parameter [login] is missing in sub call [destroy_ticket]';
+ my $login = exists $p_r->{login} ? $p_r->{login} : confess $msg;
+
+ $self->store_ticket(
+ { login => $login, ticket => undef, valid => undef } );
+
+ return 1;
+
+ }
+
+ sub fetch_ticket {
+
+ my ( $self, $p_r ) = @_;
+ my $msg = 'parameter [login] is missing in sub call [fetch_ticket]';
+ my $login = exists $p_r->{login} ? $p_r->{login} : confess $msg;
+
+ my $ticket = $cred{$login}->{ticket};
+ my $valid = $cred{$login}->{valid};
+
+ return ( $ticket, $valid );
+ }
+
+ sub store_ticket {
+
+ my ( $self, $p_r ) = @_;
+ my $m = 'parameter [login] is missing in sub call [store_ticket]';
+ my $l = exists $p_r->{login} ? $p_r->{login} : confess $m;
+ $m = 'parameter [ticket] is missing in sub call [store_ticket]';
+ my $t = exists $p_r->{ticket} ? $p_r->{ticket} : confess $m;
+ $m = 'parameter [valid] is missing in sub call [store_ticket]';
+ my $v = exists $p_r->{valid} ? $p_r->{valid} : confess $m;
+ my $go = get_logger(__PACKAGE__);
+
+ # undef can be stored also (see destroy)
+ $go->debug( 'login: ', { filter => $ifdef->($l) } );
+ $go->debug( 'ticket: ', { filter => $ifdef->($t) } );
+ $go->debug( 'value: ', { filter => $ifdef->($v) } );
+ $cred{$l} = { ticket => $t, valid => $v, };
+
+ return 1;
+ }
+
+ sub is_ticket_equal_stored {
+
+ my ( $self, $p_r ) = @_;
+ my $msg = 'parameter [login] is missing in sub call [store_ticket]';
+ my $login = exists $p_r->{login} ? $p_r->{login} : confess $msg;
+ $msg = 'parameter [ticket] is missing in sub call [store_ticket]';
+ my $ticket = exists $p_r->{ticket} ? $p_r->{ticket} : confess $msg;
+
+ my ( $stored_ticket, $valid )
+ = $self->fetch_ticket( { login => $login } );
+
+ if ( $stored_ticket eq $ticket ) {
+ return 1;
+ }
+ else {
+ return 0;
+ }
+
+ }
+
+ sub is_ticket_valid_now {
+
+ my ( $self, $p_r ) = @_;
+ my $msg = 'parameter [login] is missing in sub call [store_ticket]';
+ my $login = exists $p_r->{login} ? $p_r->{login} : confess $msg;
+ $msg = 'parameter [ticket] is missing in sub call [store_ticket]';
+ my $ticket = exists $p_r->{ticket} ? $p_r->{ticket} : confess $msg;
+
+ my $r = $self->is_ticket_valid(
+ { login => $login, ticket => $ticket, time => $self->now } );
+
+ return $r;
+
+ }
+
+ sub is_ticket_valid {
+
+ my ( $self, $p_r ) = @_;
+ my $m = 'param. [login] is missing in sub call [is_ticket_valid]';
+ my $l = exists $p_r->{login} ? $p_r->{login} : confess $m;
+ $m = 'param. [ticket] is missing in sub call [is_ticket_valid]';
+ my $t = exists $p_r->{ticket} ? $p_r->{ticket} : confess $m;
+ $m = 'param. [time] is missing in sub call [is_ticket_valid]';
+ my $j = exists $p_r->{time} ? $p_r->{time} : confess $m;
+
+ my $go = get_logger(__PACKAGE__);
+
+ my ( $s, $v ) = $self->fetch_ticket( { login => $l } );
+ if ( defined $s
+ and defined $t
+ and $s eq $t
+ and length $t == $TICKET_LENGTH
+ and defined $j
+ and defined $v
+ and $j <= $v
+ and $j > 0 )
+ {
+ return 1; # SUCCESS
+ }
+ else {
+ $go->debug(
+ 'login: ',
+ {
+ filter => sub { return $l if defined $l }
+ }
+ );
+ $go->debug( 'login: ', { filter => $ifdef->($l) } );
+ $go->debug( 'got ticket: ', { filter => $ifdef->($t) } );
+ $go->debug( 'stored ticket: ', { filter => $ifdef->($s) } );
+ $go->debug( 'got valid: ', { filter => $ifdef->($j) } );
+ $go->debug( 'stored valid: ', { filter => $ifdef->($v) } );
+ return 0; # FAILURE
+
+ }
+ return 0; # FAILURE
+ }
+
+ sub seed : PRIVATE {
+
+ # sub will be executed in readonly section!
+ Log::Log4perl::init_once( log_cfg() );
+ my $l = get_logger(__PACKAGE__);
+
+ # Calculating secret random seed for this session
+ # "S ISp&FtR0z$EU!We8DvpUzC26D0RE1pVW8vSXp9at5RUwXk
+ # WesmQvJY!w!LrLHdo^wB7f6lr7U9PGPTYhxTI!PhKjXhMmZZK
+ # ckIi^Qbl&g^$Qir!9S5LIoo!J1bX*OHVw"
+
+ srand;
+ my @chars = @RND_SEED_CHARS;
+ my $seed = join q{},
+ @chars[ map { rand @chars } ( 1 .. $SEED_LENGTH ) ];
+
+ $l->debug("new seed [$seed]");
+
+ return $seed;
+ }
+
+ sub log_cfg {
+
+ my $cfg = <<'EOF';
+ log4perl.category.Ticket::Simple = WARN, S
+ log4perl.appender.S = Log::Log4perl::Appender::ScreenColoredLevels
+ log4perl.appender.S.stderr = 0
+ log4perl.appender.S.layout = Log::Log4perl::Layout::PatternLayout
+ log4perl.appender.S.layout.ConversionPattern = %d{yyyy-MM-dd+HH:mm:ss} %M <%L>: %m%n
+EOF
+
+ return \$cfg;
+ }
+
+} # end insite out class
+
+1;
+__END__
+
+=pod
+
+=for stopwords Christian Kuelker log_cfg
+
+=head1 NAME
+
+Ticket::Simple - A basic ticket system.
+
+=head1 VERSION
+
+version v0.0.2
+
+=head1 SYNOPSIS
+
+ my $ts=Ticket::Simple->new();
+
+or
+
+ my $ts=Ticket::Simple->new({ttl=>600});
+
+
+=head1 DESCRIPTION
+
+Provides a simple ticket system for creating, storing, fetching, comparing
+user assigned tickets.
+
+
+=head1 SUBROUTINES/METHODS
+
+=head2 create_ticket
+
+=head2 wipe_ticket
+
+=head2 destroy_ticket
+
+=head2 fetch_ticket
+
+=head2 is_ticket_equal_stored
+
+=head2 is_ticket_valid
+
+=head2 is_ticket_valid_now
+
+Test if the ticket was issued
+
+=head2 now
+
+=head2 seed
+
+=head2 store_ticket
+
+=head2 log_cfg
+
+=head2 set_ttl
+
+=head2 get_ttl
+
+=head1 DIAGNOSTICS
+
+
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+No external configuration needed.
+
+=head1 DEPENDENCIES
+
+ Carp;
+ Class::Std
+ Digest::MD5
+ Log::Log4perl
+ Readonly
+ Time::HiRes
+ version
+
+=head1 INCOMPATIBILITIES
+
+Not known.
+
+=head1 BUGS AND LIMITATIONS
+
+Not known.
+
+=head1 AUTHOR
+
+Christian Kuelker E<lt>christian.kuelker at cipworx.orgE<gt>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (C) 2009 by Christian Kuelker
+
+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 2, 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, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
+02111-1307 USA
+
+=cut
Added: branches/upstream/libticket-simple-perl/current/t/00.load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/00.load.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/00.load.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/00.load.t Wed May 19 12:35:53 2010
@@ -1,0 +1,7 @@
+use Test::More tests => 1;
+
+BEGIN {
+use_ok( 'Ticket::Simple' );
+}
+
+diag( "Testing Ticket::Simple $Ticket::Simple::VERSION" );
Added: branches/upstream/libticket-simple-perl/current/t/10.init_tests.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/10.init_tests.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/10.init_tests.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/10.init_tests.t Wed May 19 12:35:53 2010
@@ -1,0 +1,18 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 5;
+
+BEGIN {
+ use_ok( 'Ticket::Simple' );
+}
+
+# Test ts creation for Ticket::Simple
+my $ts = Ticket::Simple->new();
+ok( $ts, '->new returns true' );
+ok( ref $ts, '->new returns a reference' );
+isa_ok( $ts, 'SCALAR' , '->new returns a hash reference' );
+isa_ok( $ts, 'Ticket::Simple', '->new returns a Ticket::Simple object' );
+#ok( scalar keys %$ts == 3, '->new returns an object with 3 attributes' );
+
Added: branches/upstream/libticket-simple-perl/current/t/20_now.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/20_now.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/20_now.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/20_now.t Wed May 19 12:35:53 2010
@@ -1,0 +1,19 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 4;
+use Time::HiRes qw(gettimeofday);
+
+BEGIN {
+ use_ok('Ticket::Simple');
+}
+
+my ( $s1, $ms1 ) = gettimeofday;
+my $ts = Ticket::Simple->new();
+my $n = $ts->now();
+my ( $s2, $ms2 ) = gettimeofday;
+ok( $n, '- now returns true' );
+ok( $n > "$s1.$ms1", '- now > before' );
+ok( $n < "$s2.$ms2", '- now < after' );
+
Added: branches/upstream/libticket-simple-perl/current/t/21_create_ticket.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/21_create_ticket.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/21_create_ticket.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/21_create_ticket.t Wed May 19 12:35:53 2010
@@ -1,0 +1,37 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 13;
+
+use Digest::MD5 qw(md5_hex);
+use Time::HiRes qw(gettimeofday);
+
+BEGIN {
+ use_ok('Ticket::Simple');
+}
+
+my ( $s1, $ms1 ) = gettimeofday;
+my $ts = Ticket::Simple->new();
+my ( $t, $v ) = $ts->create_ticket( { login => 'test' } );
+my ( $s2, $ms2 ) = gettimeofday;
+ok( $t, '- crate_ticket returns ticket' );
+ok( $v, '- create_ticket returns valid until time' );
+ok( $v > "$s1.$ms1", '- now > before' );
+ok( $v > "$s2.$ms2", '- now > after, if not ttl wrong' );
+
+#diag( "ticket [$t]");
+ok( ( length $t ) == 32, '- lenght ok' );
+
+my ( $t1, $v1 )
+ = $ts->create_ticket( { login => 'test', time => "$s1.$ms1" } );
+ok( $t1, '- crate_ticket returns ticket' );
+ok( $v1, '- create_ticket returns valid until time' );
+ok( $v1 > "$s1.$ms1", '- now > before' );
+ok( $v1 > "$s2.$ms2", '- now > after, if not ttl wrong' );
+ok( ( length $t1 ) == 32, '- lenght ok' );
+my ( $t2, $v2 )
+ = $ts->create_ticket( { login => 'test', time => "$s1.$ms1" } );
+ok( $t1 eq $t2, '- recreated ticket is the same' );
+ok( $v1 == $v2, '- recreated vaild until time is the same' );
+
Added: branches/upstream/libticket-simple-perl/current/t/22_store_ticket.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/22_store_ticket.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/22_store_ticket.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/22_store_ticket.t Wed May 19 12:35:53 2010
@@ -1,0 +1,15 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 2;
+
+BEGIN {
+ use_ok('Ticket::Simple');
+}
+
+my $ts = Ticket::Simple->new();
+my ( $t, $v ) = $ts->create_ticket( { login => 't' } );
+ok( $ts->store_ticket( { login => 't', ticket => $t, valid => $v } ),
+ '- can store ticket' )
+
Added: branches/upstream/libticket-simple-perl/current/t/23_fetch_ticket.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/23_fetch_ticket.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/23_fetch_ticket.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/23_fetch_ticket.t Wed May 19 12:35:53 2010
@@ -1,0 +1,20 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 4;
+
+BEGIN {
+ use_ok('Ticket::Simple');
+}
+
+my $ts = Ticket::Simple->new();
+my ( $t1, $v1 ) = $ts->create_ticket( { login => 't' } );
+ok( $ts->store_ticket( { login => 't', ticket => $t1, valid => $v1 } ),
+ '- can store ticket' );
+my ( $t2, $v2 ) = $ts->fetch_ticket( { login => 't' } );
+ok( $t1 eq $t2, '- ticket are equal' );
+ok( $v1 == $v2, '- valid until time is the same' );
+
+#diag("t1 [$t1] t2 [$t2] v1 [$v1] v2 [$v2]");
+
Added: branches/upstream/libticket-simple-perl/current/t/24_is_ticket_equal_stored.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/24_is_ticket_equal_stored.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/24_is_ticket_equal_stored.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/24_is_ticket_equal_stored.t Wed May 19 12:35:53 2010
@@ -1,0 +1,17 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 3;
+
+BEGIN {
+ use_ok('Ticket::Simple');
+}
+
+my $ts = Ticket::Simple->new();
+my ( $t1, $v1 ) = $ts->create_ticket( { login => 't' } );
+ok( $ts->store_ticket( { login => 't', ticket => $t1, valid => $v1 } ),
+ '- can store ticket' );
+ok( $ts->is_ticket_equal_stored( { login => 't', ticket => $t1 } ),
+ '- is_ticket_equal_stored' );
+
Added: branches/upstream/libticket-simple-perl/current/t/25_is_ticket_valid.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/25_is_ticket_valid.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/25_is_ticket_valid.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/25_is_ticket_valid.t Wed May 19 12:35:53 2010
@@ -1,0 +1,28 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 5;
+
+BEGIN {
+ use_ok('Ticket::Simple');
+}
+
+my $ts = Ticket::Simple->new();
+my ( $t1, $v1 ) = $ts->create_ticket( { login => 't' } );
+ok( $ts->store_ticket( { login => 't', ticket => $t1, valid => $v1 } ),
+ '- can store ticket' );
+ok( $ts->is_ticket_valid( { login => 't', ticket => $t1, time => $v1 } ),
+ '- is_ticket_valid' );
+my $n = $ts->now();
+ok( $ts->is_ticket_valid( { login => 't', ticket => $t1, time => $n } ),
+ '- is_ticket_valid even now' );
+ok(
+ (
+ not $ts->is_ticket_valid(
+ { login => 't', ticket => $t1, time => ( $n + 3000000 ) }
+ )
+ ),
+ '- is_ticket_valid not in teh future'
+);
+
Added: branches/upstream/libticket-simple-perl/current/t/26_ttl.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/26_ttl.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/26_ttl.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/26_ttl.t Wed May 19 12:35:53 2010
@@ -1,0 +1,18 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 4;
+
+BEGIN {
+ use_ok('Ticket::Simple');
+}
+
+my $ts = Ticket::Simple->new( { ttl => 2000 } );
+ok( $ts, 'new with ttl param works' );
+my $ttl = $ts->get_ttl;
+ok( $ttl == 2000, '- got ttl out of the sytsem' );
+$ts->set_ttl(3000);
+my $ttl2 = $ts->get_ttl;
+ok( $ttl2 == 3000, '- got ttl out of the sytsem' );
+
Added: branches/upstream/libticket-simple-perl/current/t/27_wipe_ticket.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/27_wipe_ticket.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/27_wipe_ticket.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/27_wipe_ticket.t Wed May 19 12:35:53 2010
@@ -1,0 +1,31 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 8;
+
+BEGIN {
+ use_ok('Ticket::Simple');
+}
+
+my $ts = Ticket::Simple->new();
+my ( $t1, $v1 ) = $ts->create_ticket( { login => 't' } );
+ok( $ts->store_ticket( { login => 't', ticket => $t1, valid => $v1 } ),
+ '- can store ticket' );
+my ( $t2, $v2 ) = $ts->fetch_ticket( { login => 't' } );
+ok( $t1 eq $t2, '- ticket are equal' );
+ok( $v1 == $v2, '- valid until time is the same' );
+
+ok( $ts->wipe_ticket( { login => 't' } ), '- wipe ticket call ok' );
+my ( $t3, $v3 ) = $ts->fetch_ticket( { login => 't' } );
+ok( $t3 eq "", '- ticket are equal' );
+ok( $v3 == 0, '- valid until time is the same' );
+ok(
+ (
+ not $ts->is_ticket_valid(
+ { login => 't', ticket => $t3, time => $v3 }
+ )
+ ),
+ '- is ticket NOT valid'
+);
+
Added: branches/upstream/libticket-simple-perl/current/t/28_destroy_ticket.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/28_destroy_ticket.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/28_destroy_ticket.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/28_destroy_ticket.t Wed May 19 12:35:53 2010
@@ -1,0 +1,32 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 8;
+
+BEGIN {
+ use_ok('Ticket::Simple');
+}
+
+my $ts = Ticket::Simple->new();
+my ( $t1, $v1 ) = $ts->create_ticket( { login => 't' } );
+ok( $ts->store_ticket( { login => 't', ticket => $t1, valid => $v1 } ),
+ '- can store ticket' );
+my ( $t2, $v2 ) = $ts->fetch_ticket( { login => 't' } );
+ok( $t1 eq $t2, '- ticket are equal' );
+ok( $v1 == $v2, '- valid until time is the same' );
+
+ok( $ts->destroy_ticket( { login => 't' } ), '- wipe ticket call ok' );
+my ( $t3, $v3 ) = $ts->fetch_ticket( { login => 't' } );
+
+ok( ( not( defined $t3 ) ), '- ticket not defined' );
+ok( ( not( defined $v3 ) ), '- valid not defined' );
+ok(
+ (
+ not $ts->is_ticket_valid(
+ { login => 't', ticket => $t3, time => $v3 }
+ )
+ ),
+ '- is ticket NOT valid'
+);
+
Added: branches/upstream/libticket-simple-perl/current/t/29_is_ticket_valid_now.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/29_is_ticket_valid_now.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/29_is_ticket_valid_now.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/29_is_ticket_valid_now.t Wed May 19 12:35:53 2010
@@ -1,0 +1,16 @@
+#!perl -w
+
+use warnings;
+use strict;
+use Test::More tests => 3;
+
+BEGIN {
+ use_ok('Ticket::Simple');
+}
+
+my $ts = Ticket::Simple->new();
+my ( $t1, $v1 ) = $ts->create_ticket( { login => 't' } );
+ok( $ts->store_ticket( { login => 't', ticket => $t1, valid => $v1 } ),
+ '- can store ticket' );
+ok( $ts->is_ticket_valid_now( { login => 't', ticket => $t1 }),'- is_ticket_valid' );
+
Added: branches/upstream/libticket-simple-perl/current/t/leaktrace.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/leaktrace.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/leaktrace.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/leaktrace.t Wed May 19 12:35:53 2010
@@ -1,0 +1,9 @@
+use Test::More tests => 1;
+use Test::LeakTrace;
+
+no_leaks_ok {
+ use Ticket::Simple;
+ my $object = Ticket::Simple->new();
+}
+'no memory leaks';
+
Added: branches/upstream/libticket-simple-perl/current/t/perlcritic_cpan.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/perlcritic_cpan.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/perlcritic_cpan.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/perlcritic_cpan.t Wed May 19 12:35:53 2010
@@ -1,0 +1,23 @@
+#!perl
+#
+use strict;
+use warnings;
+use File::Spec;
+use Test::More;
+use English qw(-no_match_vars);
+
+if ( not $ENV{TEST_AUTHOR} ) {
+ my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
+ plan( skip_all => $msg );
+}
+
+eval { require Test::Perl::Critic; };
+
+if ($EVAL_ERROR) {
+ my $msg = 'Test::Perl::Critic required to criticise code';
+ plan( skip_all => $msg );
+}
+
+my $rcfile = File::Spec->catfile( 't', 'perlcriticrc' );
+Test::Perl::Critic->import( -profile => $rcfile );
+all_critic_ok();
Added: branches/upstream/libticket-simple-perl/current/t/perlcriticrc
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/perlcriticrc?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/perlcriticrc (added)
+++ branches/upstream/libticket-simple-perl/current/t/perlcriticrc Wed May 19 12:35:53 2010
@@ -1,0 +1,12 @@
+# CipUX Perl::Critic Configuration
+#
+# SEVERITY NAME ...is equivalent to... SEVERITY NUMBER
+# ----------------------------------------------------
+# gentle 5
+# stern 4
+# harsh 3
+# cruel 2
+# brutal 1
+
+severity = brutal
+verbose = 11
Added: branches/upstream/libticket-simple-perl/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/pod-coverage.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/pod-coverage.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/pod-coverage.t Wed May 19 12:35:53 2010
@@ -1,0 +1,11 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+if ( not $ENV{TEST_AUTHOR} ) {
+ my $msg = 'Author test. Set $ENV{TEST_AUTHOR} to a true value to run.';
+ plan( skip_all => $msg );
+}
+
+all_pod_coverage_ok();
Added: branches/upstream/libticket-simple-perl/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/pod.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/pod.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/pod.t Wed May 19 12:35:53 2010
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
Added: branches/upstream/libticket-simple-perl/current/t/refcount.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libticket-simple-perl/current/t/refcount.t?rev=58064&op=file
==============================================================================
--- branches/upstream/libticket-simple-perl/current/t/refcount.t (added)
+++ branches/upstream/libticket-simple-perl/current/t/refcount.t Wed May 19 12:35:53 2010
@@ -1,0 +1,13 @@
+use Test::More tests => 2;
+use Test::Refcount;
+
+use Ticket::Simple;
+
+my $object = Ticket::Simple->new();
+
+is_oneref( $object, '$object has a refcount of 1' );
+
+my $otherref = $object;
+
+is_refcount( $object, 2, '$object now has 2 references' );
+
More information about the Pkg-perl-cvs-commits
mailing list