locked results from the CPAN

CGI-AuthRegister
view release on metacpan or search on metacpan
  while (@_) { my $r=shift; $r =~ s/\s*$/\n/s; print F "\n$r"; }
  &unlock_mkdir($fdb);
}	  

# Read one DB record in the RFC822-like style (to add reference).
sub read_db_record {
    my $arg = shift;
    if ($arg =~ /^file=/) {
	my $f = $'; local *F; open(F, $f) or die "cannot open $f:$!";
	$arg = join('', <F>); close(F);
    }

    while ($arg =~ s/^(\s*|\s*#.*)\n//) {} # allow comments before record
    my $record;
    if ($arg =~ /\n\n+/) { $record = "$`\n"; $arg = $'; }
    else { $record = $arg; $arg = ''; }
    my $r = {};
    while ($record) {
        while ($record =~ /^(.*)(\\\n|\n[ \t]+)(.*)/)
	{ $record = "$1 $3$'" }
        $record =~ /^([^\n:]*):(.*)\n/ or die;
        my $k = $1; my $v = $2; $record = $';
        if (exists($r->{$k})) {
	    my $c = 0;
	    while (exists($r->{"$k-$c"})) { ++$c }
	    $k = "$k-$c";
        }
        $r->{$k} = $v;
    }
  return $r;
}

# 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

# Exlusive locking using mkdir
# lock_mkdir($fname); # return 1=success ''=fail
sub lock_mkdir {
  my $fname = shift; my $lockd = "$fname.lock"; my $locked;
  # First, hopefully most usual case
  if (!-e $lockd && ($locked = mkdir($lockd,0700))) { return $locked }
  my $tryfor=10; #sec
  $locked = ''; # flag
  for (my $i=0; $i<2*$tryfor; ++$i) {
    select(undef,undef,undef,0.5); # wait for 0.5 sec
    !-e $lockd && ($locked = mkdir($lockd,0700));
    if ($locked) { return $locked }
  }
  $Error.="393-ERR:Could not lock file ($fname)\n"; return $locked;
}

# Unlock using mkdir
# unlock_mkdir($fname); # return 1=success ''=fail or no lock
sub unlock_mkdir {
    my $fname = shift; my $lockd = "$fname.lock";
    if (!-e $lockd) { $Error.="400-ERR:No lock on ($fname)\n"; return '' }
    if (-d $lockd) {  return rmdir($lockd) }
    if (-f $lockd or -l $lockd) { unlink($lockd) }
    $Error.="AuthERR-1279:Unknown error"; return '';
}

########################################################################
# Section: Prepackaged HTML and CSS files

sub gen_cas_page {
  my $ret;
#<? my $c = getfile('cas-template/cas.html');
# echo "\$ret=<<'EOT';\n${c}EOT"; !>#+
$ret=<<'EOT';
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
	  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
<head><title>CAS - Central Authentication Service</title>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<meta name="Description" content="CAS - Central Authentication Service">
<meta name="viewport" content="width=device-width">
<link rel="stylesheet" href="cas-all.css" type="text/css" media="screen">
<link rel="stylesheet" href="cas-mobile.css"
 media="handheld, only screen and (max-device-width: 480px)" type="text/css">

<script type="text/javascript" language="javascript">
// <![CDATA[
function searchFocus(){document.getElementById('username').focus();}
// ]]>
</script>

<style type="text/css">
/* <![CDATA[ */
.formInput { float: left; }
/* ]]> */
</style>
</head>

<body onload="searchFocus();">
<div id="pagebox"> <div id="headerBox">
<h1>CAS <span class="hideInMobile">&ndash; Central Authentication
    </span>Service</h1></div>

<div id="content"><div id="content-left">

<form id="login_form" action="?login" method="post">
<table id="form-layout" cellspacing="0" cellpadding="5" border="0">
<tbody><tr><td width="" valign="top" align="left">&nbsp;</td>
 <td width="" valign="top" align="left">
 <h1><!--37-->Login Required
 </h1><p class="sans"><!--38-->CAS Authentication
</p></td></tr>

<!--!username--><tr><td width="" valign="top" align="left">
( run in 1.017 second using v1.01-cache-2.11-cpan-39bf76dae61 )