| 1 | #!/usr/bin/env perl |
1 | #!/usr/bin/env perl |
| 2 | |
2 | |
| 3 | ################################################################################ |
3 | ################################################################################ |
| 4 | # WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester |
4 | # WeBWorK mod_perl (c) 1995-2002 WeBWorK Team, Univeristy of Rochester |
| 5 | # $Id: wwdb,v 1.1 2003-03-21 23:30:09 sh002i Exp $ |
5 | # $Id: wwdb,v 1.2 2003-04-17 21:01:13 sh002i Exp $ |
| 6 | ################################################################################ |
6 | ################################################################################ |
| 7 | |
7 | |
| 8 | =head1 NAME |
8 | =head1 NAME |
| 9 | |
9 | |
| 10 | wwdb - command-line interface to the WeBWorK databases (WWDBv2). |
10 | wwdb - command-line interface to the WeBWorK databases (WWDBv2). |
| 11 | |
11 | |
| 12 | =cut |
12 | =cut |
| 13 | |
13 | |
| 14 | use strict; |
14 | use strict; |
| 15 | use warnings; |
15 | use warnings; |
|
|
16 | use FindBin; |
|
|
17 | use lib "$FindBin::Bin/../lib"; |
| 16 | use WeBWorK::ContentGenerator; # for cook_args |
18 | use WeBWorK::ContentGenerator; # for cook_args |
| 17 | use WeBWorK::CourseEnvironment; |
19 | use WeBWorK::CourseEnvironment; |
| 18 | use WeBWorK::DB; |
20 | use WeBWorK::DB; |
| 19 | #use WeBWorK::DB::Record::User; |
|
|
| 20 | |
21 | |
| 21 | # Command line syntax |
22 | # Command line syntax |
| 22 | # |
23 | # |
| 23 | # wwdb course command [ argument ... ] |
24 | # wwdb course command [ argument ... ] |
| 24 | # |
25 | # |
| … | |
… | |
| 27 | # |
28 | # |
| 28 | # {id="sh002i" first_name="Sam" last_name="Hathaway"} |
29 | # {id="sh002i" first_name="Sam" last_name="Hathaway"} |
| 29 | # |
30 | # |
| 30 | # You'll have to protect arguments like this from your shell by enclosing them |
31 | # You'll have to protect arguments like this from your shell by enclosing them |
| 31 | # in single quotes. |
32 | # in single quotes. |
|
|
33 | # |
|
|
34 | # The special string \undef represents an undefined value. You'll have to |
|
|
35 | # protect this from your shell as well. Use \\undef or '\undef'. |
| 32 | |
36 | |
| 33 | sub main(@) { |
37 | sub main(@) { |
| 34 | my ($course, $command, @arguments) = @_; |
38 | my ($course, $command, @arguments) = @_; |
| 35 | |
39 | |
|
|
40 | unless ($course and $command) { |
|
|
41 | die "usage: $0 course command [arguments ...]\n"; |
|
|
42 | } |
|
|
43 | |
| 36 | my $ce = WeBWorK::CourseEnvironment->new($ENV{WEBWORK_ROOT}, "", $course); |
44 | my $ce = WeBWorK::CourseEnvironment->new($ENV{WEBWORK_ROOT}, "", $course); |
| 37 | my $db = WeBWorK::DB->new($ce); |
45 | my $db = WeBWorK::DB->new($ce); |
|
|
46 | |
|
|
47 | if ($command eq "dumpDB") { |
|
|
48 | print $db->$command("set_user"); |
|
|
49 | exit; |
|
|
50 | } |
| 38 | |
51 | |
| 39 | die "$command: unsupported command.\n" |
52 | die "$command: unsupported command.\n" |
| 40 | unless $db->can($command); |
53 | unless $db->can($command); |
| 41 | |
54 | |
| 42 | my ($verb, $noun) = $command =~ m/^(list|new|get|put|delete)(.*?)s?$/; |
55 | my ($verb, $noun) = $command =~ m/^(list|add|get|put|delete)(.*?)s?$/; |
| 43 | |
56 | |
| 44 | my $type = "WeBWorK::DB::Record::"; |
57 | my $type = "WeBWorK::DB::Record::"; |
| 45 | if ($noun =~ m/^Global(User)?(Set|Problem)$/) { |
58 | if ($noun =~ m/^Global(User)?(Set|Problem)$/) { |
| 46 | $type .= "$1$2"; |
59 | $type .= "$1$2"; |
| 47 | } else { |
60 | } else { |
| 48 | $type .= $noun; |
61 | $type .= $noun; |
| 49 | } |
62 | } |
| 50 | |
63 | |
| 51 | foreach (@arguments) { |
64 | foreach (@arguments) { |
|
|
65 | if (m/^\\undef$/) { |
|
|
66 | $_ = undef; |
| 52 | if (m/^{(.*)}$/) { |
67 | } elsif (m/^{(.*)}$/) { |
| 53 | $_ = string2record($type, $1); |
68 | $_ = string2record($type, $1); |
| 54 | } |
69 | } |
| 55 | } |
70 | } |
| 56 | |
71 | |
| 57 | my @result = $db->$command(@arguments); |
72 | my @result = $db->$command(@arguments); |
| 58 | |
73 | |
| 59 | if ($verb eq "list") { |
74 | if ($verb eq "list") { |
| 60 | print join("\n", @result), "\n"; |
75 | print join("\n", @result), "\n"; |
| 61 | } elsif ($verb eq "new") { |
76 | } elsif ($verb eq "add") { |
| 62 | # ignore result |
77 | print "result: $result[0]\n"; |
| 63 | } elsif ($verb eq "get") { |
78 | } elsif ($verb eq "get") { |
| 64 | if (defined $result[0]) { |
79 | if (defined $result[0]) { |
| 65 | print "{", record2string($result[0]), "}\n"; |
80 | print "{", record2string($result[0]), "}\n"; |
| 66 | } else { |
81 | } else { |
| 67 | print "$arguments[0]: record not found\n"; |
82 | print join("/", @arguments), ": record not found\n"; |
| 68 | } |
83 | } |
| 69 | } elsif ($verb eq "put") { |
84 | } elsif ($verb eq "put") { |
| 70 | # ignore result |
85 | print "result: $result[0]\n"; |
| 71 | } elsif ($verb eq "delete") { |
86 | } elsif ($verb eq "delete") { |
| 72 | # ignore result |
87 | print "result: $result[0]\n"; |
| 73 | } |
88 | } |
| 74 | } |
89 | } |
| 75 | |
90 | |
| 76 | sub string2record($$) { |
91 | sub string2record($$) { |
| 77 | my ($type, $string) = @_; |
92 | my ($type, $string) = @_; |
Parent Directory
| 
Revision Log
| 
Patch