/[libconf]/libconf/perl-Libconf/Glueconf/Autologin.pm
ViewVC logotype

Diff of /libconf/perl-Libconf/Glueconf/Autologin.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by chl, Sun Apr 13 22:31:03 2003 UTC revision 1.7 by dams, Mon Aug 18 18:47:12 2003 UTC
# Line 23  Line 23 
23  package Libconf::Glueconf::Autologin;  package Libconf::Glueconf::Autologin;
24  use strict;  use strict;
25  use vars qw(@ISA);  use vars qw(@ISA);
26  use Libconf::Glueconf;  use Libconf;
27  use Libconf::Libconf;  use Libconf::Glueconf::Shell;
28  @ISA = qw(Libconf);  #use Libconf::Glueconf;
29    our @ISA = qw(Libconf::Glueconf::Shell);
30    our $data_synopsis;
31    
32    # $data_synopsis_version is optionnal
33  sub new {  sub new {
34      my ($pkg, $filename) = @_;      my ($class, $filename, $data_synopsis_version) = @_;
35      my $libconf = $pkg->Libconf::new($filename, 'shell', '');      my ($data_description, $data_mapping);
36      tie my %wrapper, 'Libconf::Glueconf::Autologin::Wrapper', $libconf;      if (defined $data_synopsis) {
37      \%wrapper;          $data_synopsis_version ||= 'default_version';
38  }          $data_description = $data_synopsis->{$data_synopsis_version}{description};
39            $data_mapping = $data_synopsis->{$data_synopsis_version}{mapping};
40  package Libconf::Glueconf::Autologin::Wrapper;          use Data::Dumper;
41            print " ------ ****** : " . Dumper($data_description) . "\n";
 sub debug { $ENV{DEBUG} and print @_ }  
   
 sub TIEHASH {  
     my ($pkg, $libconf) = @_;  
     debug "Wrapper - TIEHASH\n";  
     bless { libconf => $libconf }, $pkg;  
 }  
   
 sub CLEAR {  
     my ($obj) = @_;  
     debug "Wrapper - CLEAR\n";  
     $obj->{libconf}->clear();  
 }  
   
 sub DELETE {  
     my ($obj, $key) = @_;  
     debug "Wrapper - DELETE - key: $key\n";  
     my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $key });  
     foreach (@pos) {  
         $obj->{libconf}->deleteAtom($_);  
     }  
 }  
   
 sub FIRSTKEY {  
     my ($obj) = @_;  
     debug "Wrapper - FIRSTKEY\n";  
     my $atom = $obj->{libconf}->getAtom(0);  
     $atom->{key};  
 }  
   
 sub EXISTS {  
     my ($obj, $key) = @_;  
     debug "Wrapper - EXISTS - key : $key\n";  
     my $pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $key });  
     defined $pos;  
 }  
   
 sub NEXTKEY {  
     my ($obj, $lastkey) = @_;  
     debug "Wrapper - NEXTKEY - lastkey : $lastkey\n";  
     my @pos = $obj->{libconf}->findAtomPos( { type => 'KEY_VALUE', key => $lastkey }); #FIXME : double entries should be removed elsewhere  
     $pos[-1]+1 >= $obj->{libconf}->size() and return undef;  
     $obj->{libconf}->getAtom($pos[-1]+1)->{key};  
 }  
   
 sub STORE {  
     my ($obj, $key, $value) = @_;  
     debug "Wrapper - STORE - key : $key - value : $value\n";  
     ref $value eq '' or die 'trying to store anything else than a value';  
     my $index;  
     my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUE', key => $key });  
     if (@pos == 0) {  
         $index = $obj->{libconf}->appendAtom({ type => 'KEY_VALUE', key => $key });  
     } else {  
         $index = $pos[-1];  
42      }      }
43      $obj->{libconf}->editAtom($index, { type => 'KEY_VALUE', key => $key, value => $value });      bless $class->SUPER::new($filename, $data_description, $data_mapping), $class;
44  }  }
45    
46  sub FETCH {  $data_synopsis ||= {};
47      my ($obj, $key) = @_;  $data_synopsis->{default_version} =
48      debug "Wrapper - FETCH - key : $key\n";    {
49      $key eq 'libconf' and return $obj->{libconf};     description => {
50      my @pos = $obj->{libconf}->findAtomPos({ type => 'KEY_VALUE', key => $key });                     # Start the session as the user specified here.
51      $obj->{libconf}->getAtom($pos[-1])->{value};                     # This setting is mandatory. If omitted, autologin will not run.
52  }                     # If autologin was compiled with --enable-paranoid, autologin will
53                       # not run if the user specified has UID or GID 0.
54                       USER => { type => 'STRING',
55                                 values => sub {
56                                     require Libconf::System::Users;
57                                     my $sys_users = new Libconf::System::Users;
58                                     [$sys_users->getUsersList(sub { $_[0]->{UID} >= 500 })];
59                                 }
60                               },
61    
62                       # The script or program listed here will be executed as the user
63                       # specified above.
64                       # If this setting is omitted, /usr/X11R6/bin/startx will be used.
65                       EXEC => { type => 'COMMAND' }, #[script or program]
66    
67                       # You can use this setting to turn off autologin even if it is
68                       # installed and the config file exists and is considered safe.
69                       # If this setting is omitted, "yes" is assumed.
70                       AUTOLOGIN => { type => 'BOOLEAN' },
71                      },
72      };
73    
74  1;  1;
75    

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26