CGI-AuthRegister

 view release on metacpan or  search on metacpan

AuthRegister.pm  view on Meta::CPAN

# $User      = '';  # User data structure
# $UserEmail = '';  # User email address
# $SendLogs  = '';  # If true, send logs by email to admin ($Email_bcc)

$Email_from = ''; # Example: $SiteId.' <vlado@dnlp.ca>';
$Email_bcc  = ''; # Example: $SiteId.' Bcc <vlado@dnlp.ca>';

$Sendmail = "/usr/lib/sendmail"; # Sendmail with full path

# Some function prototypes
sub putfile($@);

########################################################################
# Section: Configuration
# sets site id as the base directory name; imports configuration.pl if exists
sub import_dir_and_config {
  my $base = `pwd`; $base =~ /\/([^\/]*)$/; $base = $1; $base =~ s/\s+$//;
  $SiteId = $SiteName = $base;
  if (-r 'configuration.pl') { package main; require 'configuration.pl'; }
}

AuthRegister.pm  view on Meta::CPAN

    s/[\Wx]/'x'.uc unpack("H2",$&)/ge;
    return $_;
}

sub decode_w {
    local $_ = shift;
    s/x([0-9A-Fa-f][0-9A-Fa-f])/pack("c",hex($1))/ge;
    return $_;
}

sub encodeuri($) {
  local $_ = shift;
  s/[^-A-Za-z0-9_.~:\/?=]/"%".uc unpack("H2",$1)/ge;
  return $_;
}

# Prepare for HTML display by quoting meta characters.
sub htmlquote($) { local $_ = shift; s/&/&amp;/g; s/</&lt;/g; return $_; }

sub emailcheckok {
    my $email = shift;
    if ($email =~ /^[a-zA-Z][\w\.+-]*[a-zA-Z0-9+-]@
         [a-zA-Z0-9][\w\.-]*[a-zA-Z0-9]\.[a-zA-Z][a-zA-Z\.]*[a-zA-Z]$/x)
    { return 1 }
    return '';
}

sub useridcheckok {

AuthRegister.pm  view on Meta::CPAN

}

# parameters: $n - sequence length; @_ domain elements
sub random_string {
    my $n = shift;
    return '' if $n < 1;
    my @r = map { $_[rand($#_+1)] } (1..$n);
    return join('',@r);
}

sub putfile($@) {
    my $f = shift; local *F;
    if (!open(F, ">$f")) { $Error.="325-ERR:Cannot write ($f):$!\n"; return; }
    for (@_) { print F } close(F);
}

sub getfile($) {
    my $f = shift; local *F;
    if (!open(F, "<$f")) {
      $Error.="ERR-1099:getfile:cannot open $f:$!"; return; }
    my @r = <F>; close(F);
    return wantarray ? @r : join ('', @r);
}

########################################################################
# Section: Simple file locking using mkdir

Makefile.PL  view on Meta::CPAN

      type => 'git',
      url => 'https://github.com/vkeselj/CGI-AuthRegister.git',
      web => 'https://github.com/vkeselj/CGI-AuthRegister',
}}}) : () ));

# private parts of Makefile
open(M, ">>Makefile") or die;
if ( -f 'priv.make' ) { print M getfile('priv.make') }
close(M);

sub getfile($) {
    my $f = shift;
    local *F;
    open(F, "<$f") or die "getfile:cannot open $f:$!";
    my @r = <F>;
    close(F);
    return wantarray ? @r : join ('', @r);
}