Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

get survey questions into db

  • Loading branch information...
commit 1b5cbeb4bce4621517a05006650a179a387b40e3 1 parent 335727b
Kieren Diment authored
BIN  Survey-Perl/db/survey.db
Binary file not shown
115 Survey-Perl/script/populate_questions.pl
... ... @@ -0,0 +1,115 @@
  1 +#!/usr/bin/env perl
  2 +use warnings;
  3 +use strict;
  4 +use FindBin qw/$Bin/;
  5 +use lib "$Bin/../lib";
  6 +use PerlSurvey::Schema;
  7 +
  8 +my $dispatch = {
  9 + ac_textbox => sub {
  10 + my ($item, $section, $rs) = @_;
  11 + $item->{section} = $section->first;
  12 + $item->{validation} = qr/^.*?$/;
  13 + $rs->create($item);
  14 + },
  15 + likert => sub {
  16 + my ($item, $section, $rs) = @_;
  17 + $item->{validation} = qr/^[0-7]$/;
  18 + $item->{section} = $section->first;
  19 + $rs->create($item);
  20 + },
  21 + multiselect => sub {
  22 + my ($item, $section, $rs) = @_;
  23 + foreach my $l (@{$item->{labels}}) {
  24 + $l =~ s/\s/_/g;
  25 + $l = lc($l);
  26 + my $row = { field => $item->{field} . "_" . $l,
  27 + title => $item->{title},
  28 + section => $section->first,
  29 + };
  30 + $rs->create($row);
  31 + }
  32 + },
  33 +
  34 + radio_list => sub {
  35 + my ($item, $section, $rs) = @_;
  36 + $item->{section} = $section->first;
  37 + my $max = $#{$item->{labels}} + 1;
  38 + $item->{validation} = qr/[1-$max]/;
  39 + delete $item->{labels};
  40 + $DB::single=1;
  41 + $rs->create($item);
  42 + },
  43 +
  44 + textarea => sub {
  45 + my ($item, $section, $rs) = @_;
  46 + $item->{section} = $section->first;
  47 + $item->{validation} = qr/^.*?$/;
  48 + $rs->create($item);
  49 + },
  50 +
  51 + textbox => sub {
  52 + my ($item, $section, $rs) = @_;
  53 + $item->{section} = $section->first;
  54 + $item->{validation} = qr/^.*?$/;
  55 + $rs->create($item);
  56 + },
  57 +};
  58 +
  59 +
  60 +my $data = do "$Bin/../survey/en.pl";
  61 +my $dsn = "dbi:SQLite:dbname=$Bin/../db/survey.db";
  62 +my $schema = PerlSurvey::Schema->connect($dsn);
  63 +foreach my $section (@$data) {
  64 + my $sec_rs = $schema->resultset('Section');
  65 + my $sect = shift @$section;
  66 + $sec_rs->create({ title => $sect->{section_title}});
  67 + warn "Section " . $sect->{section_title} . "\n";
  68 + foreach my $q (@$section) {
  69 + my $rs = $schema->resultset('Question');
  70 + next if $q->{type} eq 'heading';
  71 + warn "Creating " . $q->{title} . " of " . $q->{type} . "\n";
  72 + $dispatch->{$q->{type}}->($q, $sec_rs, $rs);
  73 + }
  74 +}
  75 +
  76 +__END__
  77 +
  78 +=head1 SCHEMA
  79 +
  80 +create table sections (
  81 + id integer primary key,
  82 + title text
  83 +);
  84 +
  85 +create table questions (
  86 + field varchar(128),
  87 + title text,
  88 + type text,
  89 + validation text,
  90 + section integer,
  91 + foreign key (section) references sections(id),
  92 + primary key (field)
  93 +);
  94 +
  95 +create table user (
  96 + userid integer primary key,
  97 + sessionid varchar(128),
  98 + username varchar (64),
  99 + email varchar(128),
  100 + language char(10)
  101 +);
  102 +
  103 +create table answers (
  104 + id integer primary key,
  105 + user integer,
  106 + field varchar(128),
  107 + answer text,
  108 + time_entered char(19) default current_timestamp,
  109 + useragent text,
  110 + foreign key (user) references user(userid),
  111 + foreign key (field) references questions(field)
  112 + );
  113 +
  114 +
  115 +2010-02-21 03:59:47

0 comments on commit 1b5cbeb

Please sign in to comment.
Something went wrong with that request. Please try again.