"Fossies" - the Fresh Open Source Software Archive

Member "absence-v2.1/cgi-bin/Test/sql1.pl" (29 Jun 2009, 2009 Bytes) of package /linux/www/web-absence-2.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/perl
    2 
    3 use DBI;
    4 use Carp;
    5 
    6 my $DB_NAME     = 'absence';
    7 my $DB_HOST     = 'localhost';
    8 my $DB_USER     = 'absence';
    9 my $DB_PASS     = 'absence';
   10 
   11 my $DBH = DBI->connect("dbi:Pg:dbname=$DB_NAME",
   12     $DB_USER, $DB_PASS, {AutoCommit => 1, RaiseError => 1});
   13 
   14 my $user_id = shift || 2;
   15 print "using User-ID=$user_id\n";
   16 
   17 my @groups = findReadableGroups($user_id);
   18 print "Groups: ",join(', ', @groups), "\n";
   19 
   20 defined($DBH) && $DBH->disconnect;
   21 
   22 #========================================================================
   23 
   24 sub findReadableGroups
   25 {
   26     my $user_id = shift;
   27 
   28     my %unique_groups;
   29 
   30     #---------------------------------------------------------------
   31     # first find all groups to which the object associated with
   32     # $user_id belongs (if any)
   33     # next, look at access records
   34     #---------------------------------------------------------------
   35 
   36     my $sql = qq{
   37         SELECT map.group_id
   38         FROM
   39             c_group_object  AS map,
   40             v_user          AS u
   41         WHERE
   42             (u.id           = $user_id AND
   43              map.object_id  = u.object_id)
   44         UNION
   45         SELECT ref_id AS group_id
   46         FROM c_access
   47         WHERE
   48             (user_id        = $user_id) AND
   49             (type           = 'group') AND
   50             (ref_id         IS NOT NULL);
   51     };
   52 
   53     my $sth = $DBH->prepare($sql);
   54     $sth->execute || confess "statement [$sql] failed";
   55     my $tbl_ary_ref = $sth->fetchall_arrayref([0]);
   56 
   57     my @result;
   58     foreach my $row (@{$tbl_ary_ref}) {
   59         push(@result, $row->[0]);
   60     }
   61 
   62     @result;
   63 }
   64 
   65 sub dbSelect
   66 {
   67     my $sql = shift;
   68 
   69     my $sth;
   70     eval {
   71         $sth = $DBH->prepare($sql);
   72     };
   73     if ($@) {
   74         confess $@;
   75     }
   76 
   77     $sth->execute || confess "statement [$sql] failed";
   78 
   79     my @result;
   80     my $ref;
   81     while(defined($ref = $sth->fetchrow_hashref)) {
   82         push(@result, $ref);
   83     }
   84 
   85     if (wantarray) {
   86         return @result;
   87     } else {
   88         @result || return undef;
   89         return $result[0];
   90     }
   91 }
   92