home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Perishable.pm < prev    next >
Encoding:
Perl POD Document  |  2002-06-13  |  2.5 KB  |  111 lines
  1. package Apache::Htpasswd::Perishable;
  2.  
  3. use strict;
  4. use warnings;
  5. use Apache::Htpasswd;
  6. use Date::Simple qw(today);
  7.  
  8. our @ISA = qw(Apache::Htpasswd);
  9.  
  10. our $VERSION = '1.00';
  11.  
  12.  
  13. # Preloaded methods go here.
  14.  
  15. sub new {
  16.   my $class = shift;
  17.   my $file = shift;
  18.  
  19.   my $self = bless {}, $class;
  20.  
  21.   system("touch $file") unless -f $file;
  22.   unless(-f $file){
  23.     $self->{'ERROR'} = __PACKAGE__. "::new Cannot create $file: $!";
  24.     croak $self->error();
  25.   }
  26.  
  27. #i hope he cleans this up.
  28.   $self->{'PASSWD'} = $file;
  29.   $self->{'ERROR'} = "";
  30.   $self->{'LOCK'} = 0;
  31.   $self->{'OPEN'} = 0;
  32.  
  33.   return $self;
  34. }
  35.  
  36. sub extend {
  37.   my ($self,$login,$days) = @_;
  38.  
  39.   die "provide a login" unless $login;
  40.   die "provide a login" unless $days;
  41.  
  42.   $self->fetchInfo($login);
  43.   my $current = Date::Simple->new($self->fetchInfo($login));
  44.   die "Invalid date already exists.  Cannot extend: $!" unless $current;
  45.  
  46.   my $extended = $current + $days;
  47.  
  48.   $self->writeInfo($login,$extended) or die "couldn't set expiration date: ".$self->error;
  49.   return 1;
  50. }
  51.  
  52. sub expire {
  53.   my ($self,$login,$days) = @_;
  54.  
  55.   die "provide a login" unless $login;
  56.   unless(defined $days){
  57.     my $expires = $self->fetchInfo($login);
  58.     my $today = today();
  59.     return $expires - $today;
  60.   }
  61.  
  62.   my $date = today();
  63.   my $expire = $date + $days;
  64.  
  65.   $self->writeInfo($login,$expire) or die "couldn't set expiration date: ".$self->error;
  66.   return 1;
  67. }
  68.  
  69. # Autoload methods go after =cut, and are processed by the autosplit program.
  70.  
  71. 1;
  72. __END__
  73. # Below is stub documentation for your module. You better edit it!
  74.  
  75. =head1 NAME
  76.  
  77. Apache::Htpasswd::Perishable - Perl extension for expiring htaccess entries
  78.  
  79. =head1 SYNOPSIS
  80.  
  81.   use Apache::Htpasswd::Perishable;
  82.  
  83. =head1 DESCRIPTION
  84.  
  85. This module allows you to define and extend an expiration date that is put into the
  86. extra-info field of an .htpasswd entry like:
  87.  
  88.   username:encrypted-password:extra-info
  89.  
  90.  
  91. =head2 METHODS
  92.  
  93. This module inherits all methods from Apache::Htpasswd, and also adds:
  94.  
  95. expire() - expire($username,$days_from_today).  (over)writes the extra-info field
  96. of an .htpasswd entry.  Calling expire($username) returns the number of days
  97. until expiration.
  98.  
  99. extend() - extend($username,$days_from_expiration).  extends the expiration date
  100. in the extra-info field of a .htpasswd entry by $days_from_expiration days.
  101.  
  102. =head1 AUTHOR
  103.  
  104. Allen Day <allenday@ucla.edu>
  105.  
  106. =head1 SEE ALSO
  107.  
  108. L<perl>. L<Apache::Htpasswd>. L<Date::Simple>.
  109.  
  110. =cut
  111.