| version 1.3, 2009/06/16 02:39:09 |
version 1.5, 2010/01/19 18:01:23 |
|
|
| #!/usr/bin/perl |
#!/usr/bin/perl |
| # $RedRiver: keyring.cgi,v 1.2 2009/06/15 17:45:46 andrew Exp $ |
# $RedRiver: keyring.cgi,v 1.4 2009/07/16 20:08:45 andrew Exp $ |
| ######################################################################## |
######################################################################## |
| # keyring.cgi *** Update and modify keyring files |
# keyring.cgi *** Update and modify keyring files |
| # |
# |
|
|
| use strict; |
use strict; |
| use warnings; |
use warnings; |
| |
|
| use Data::Dumper; |
|
| |
|
| use feature 'state'; |
use feature 'state'; |
| |
|
| use CGI; |
use CGI; |
|
|
| use Palm::Keyring; |
use Palm::Keyring; |
| use Template; |
use Template; |
| |
|
| my $base_path = '/users'; |
my @path = '/users'; |
| my $dir = $ENV{'PATH_INFO'} || '/'; |
if ($ENV{'PATH_INFO'} && $ENV{'PATH_INFO'} ne '/') { |
| |
push @path, $ENV{'PATH_INFO'}; |
| |
} |
| |
elsif ( $ENV{'REMOTE_USER'} ) { |
| |
push @path, $ENV{'REMOTE_USER'}; |
| |
# This is the users subdir; |
| |
push @path, 'rings'; |
| |
} |
| |
my $dir = catdir( @path ); |
| |
|
| my $query = CGI->new(); |
my $query = CGI->new(); |
| my $tt = Template->new( { INCLUDE_PATH => catdir('../templates') } ); |
my $tt = Template->new( { INCLUDE_PATH => catdir('../templates') } ); |
|
|
| } |
} |
| |
|
| $file = canonpath($file) if $file; |
$file = canonpath($file) if $file; |
| $dir = canonpath($dir) if $dir; |
if ( $file =~ /^ \Q$path[0]\E /xms ) { |
| |
$dir = dirname($file); |
| |
} |
| |
|
| |
$dir = canonpath($dir) if $dir; |
| if ( $dir =~ m{/\.\.//}xms ) { |
if ( $dir =~ m{/\.\.//}xms ) { |
| error('Invalid Dir [$dir]'); |
error('Invalid Dir [$dir]'); |
| $dir = ''; |
$dir = ''; |
| } |
} |
| |
|
| if ( $file =~ /^ \Q$base_path\E /xms ) { |
|
| $dir = dirname($file); |
|
| } |
|
| else { |
|
| $dir = catdir( $base_path, $dir, 'rings' ); |
|
| } |
|
| |
|
| files() if !$file; |
files() if !$file; |
| |
|
| if ( !$file ) { |
if ( !$file ) { |
|
|
| |
|
| return $query->popup_menu( |
return $query->popup_menu( |
| -name => 'category', |
-name => 'category', |
| -values => [ sort { $a <=> $b } keys %categories ], |
-values => [ |
| |
sort { lc( $categories{$a} ) cmp lc( $categories{$b} ) } |
| |
keys %categories |
| |
], |
| -default => $category, |
-default => $category, |
| -labels => \%categories, |
-labels => \%categories, |
| -onChange => "changeCategory(" |
-onChange => "changeCategory(" |
|
|
| my $d = $acct{$label}{data}; |
my $d = $acct{$label}{data}; |
| $acct{$label}{data} = sprintf "%04d/%02d/%02d", |
$acct{$label}{data} = sprintf "%04d/%02d/%02d", |
| $d->{year} + 1900, |
$d->{year} + 1900, |
| $d->{month}, |
$d->{month} + 1, |
| $d->{day}; |
$d->{day}; |
| } |
} |
| |
|
|
|
| } |
} |
| |
|
| $output |
$output |
| .= $label . ': ' |
.= $label . ': ' . |
| . $query->$type( |
#$acct{$key}{data} . |
| |
$query->$type( |
| -name => 'acct_' . $key, |
-name => 'acct_' . $key, |
| -value => $acct{$key}{data}, |
-value => $acct{$key}{data}, |
| -override => 1, |
-override => 1, |
| ) . $query->br; |
) . |
| |
$query->br; |
| } |
} |
| |
|
| return $output; |
return $output; |