Parent Directory
| 
Revision Log
This commit was manufactured by cvs2svn to create branch 'rel-2-4-patches'.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright � 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader$ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::Utils::ListingDB; 18 19 use strict; 20 use DBI; 21 use WeBWorK::Utils qw(sortByName); 22 23 use constant LIBRARY_STRUCTURE => { 24 textbook => { select => 'tbk.textbook_id,tbk.title,tbk.author,tbk.edition', 25 name => 'library_textbook', where => 'tbk.textbook_id'}, 26 textchapter => { select => 'tc.number,tc.name', name=>'library_textchapter', 27 where => 'tc.name'}, 28 textsection => { select => 'ts.number,ts.name', name=>'library_textsection', 29 where => 'ts.name'}, 30 problem => { select => 'prob.name' }, 31 }; 32 33 BEGIN 34 { 35 require Exporter; 36 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 37 38 $VERSION =1.0; 39 @ISA =qw(Exporter); 40 @EXPORT =qw( 41 &createListing &updateListing &deleteListing &getAllChapters 42 &getAllSections &searchListings &getAllListings &getSectionListings 43 &getAllDBsubjects &getAllDBchapters &getAllDBsections &getDBTextbooks 44 &getDBListings &countDBListings 45 ); 46 %EXPORT_TAGS =(); 47 @EXPORT_OK =qw(); 48 } 49 use vars @EXPORT_OK; 50 51 52 sub getDB { 53 my $ce = shift; 54 my $dbh = DBI->connect( 55 $ce->{problemLibrary_db}->{dbsource}, 56 $ce->{problemLibrary_db}->{user}, 57 $ce->{problemLibrary_db}->{passwd}, 58 { 59 PrintError => 0, 60 RaiseError => 1, 61 }, 62 ); 63 die "Cannot connect to problem library database" unless $dbh; 64 return($dbh); 65 } 66 67 =item kwtidy($s) and keywordcleaner($s) 68 Both take a string and perform utility functions related to keywords. 69 keywordcleaner splits a string, and uses kwtidy to regularize punctuation 70 and case for an individual entry. 71 72 =cut 73 74 sub kwtidy { 75 my $s = shift; 76 $s =~ s/\W//g; 77 $s =~ s/_//g; 78 $s = lc($s); 79 return($s); 80 } 81 82 sub keywordCleaner { 83 my $string = shift; 84 my @spl1 = split /\s*,\s*/, $string; 85 my @spl2 = map(kwtidy($_), @spl1); 86 return(@spl2); 87 } 88 89 sub makeKeywordWhere { 90 my $kwstring = shift; 91 my @kwlist = keywordCleaner($kwstring); 92 @kwlist = map { "kw.keyword = \"$_\"" } @kwlist; 93 my $where = join(" OR ", @kwlist); 94 return "AND ( $where )"; 95 } 96 97 =item getDBTextbooks($r) 98 Returns textbook dependent entries. 99 100 $r is a Apache request object so we can extract whatever parameters we want 101 102 $thing is a string of either 'textbook', 'textchapter', or 'textsection' to 103 specify what to return. 104 105 If we are to return textbooks, then return an array of textbook names 106 consistent with the DB subject, chapter, section selected. 107 108 =cut 109 110 sub getDBTextbooks { 111 my $r = shift; 112 my $thing = shift || 'textbook'; 113 my $dbh = getDB($r->ce); 114 my $extrawhere = ''; 115 # Handle DB* restrictions 116 my $subj = $r->param('library_subjects') || ""; 117 my $chap = $r->param('library_chapters') || ""; 118 my $sec = $r->param('library_sections') || ""; 119 if($subj) { 120 $subj =~ s/'/\\'/g; 121 $extrawhere .= " AND t.name = \'$subj\'\n"; 122 } 123 if($chap) { 124 $chap =~ s/'/\\'/g; 125 $extrawhere .= " AND c.name = \'$chap\' AND c.DBsubject_id=t.DBsubject_id\n"; 126 } 127 if($sec) { 128 $sec =~ s/'/\\'/g; 129 $extrawhere .= " AND s.name = \'$sec\' AND s.DBchapter_id = c.DBchapter_id AND s.DBsection_id=pgf.DBsection_id"; 130 } 131 my $textextrawhere = ''; 132 my $textid = $r->param('library_textbook') || ''; 133 if($textid and $thing ne 'textbook') { 134 $textextrawhere .= " AND tbk.textbook_id=\"$textid\" "; 135 } else { 136 return([]) if($thing ne 'textbook'); 137 } 138 139 my $textchap = $r->param('library_textchapter') || ''; 140 $textchap =~ s/^\s*\d+\.\s*//; 141 if($textchap and $thing eq 'textsection') { 142 $textextrawhere .= " AND tc.name=\"$textchap\" "; 143 } else { 144 return([]) if($thing eq 'textsection'); 145 } 146 147 my $selectwhat = LIBRARY_STRUCTURE->{$thing}{select}; 148 149 my $query = "SELECT DISTINCT $selectwhat 150 FROM `NPL-textbook` tbk, `NPL-problem` prob, 151 `NPL-pgfile-problem` pg, `NPL-pgfile` pgf, 152 `NPL-DBsection` s, `NPL-DBchapter` c, `NPL-DBsubject` t, 153 `NPL-chapter` tc, `NPL-section` ts 154 WHERE ts.section_id=prob.section_id AND 155 prob.problem_id=pg.problem_id AND 156 s.DBchapter_id=c.DBchapter_id AND 157 c.DBsubject_id=t.DBsubject_id AND 158 pgf.DBsection_id=s.DBsection_id AND 159 pgf.pgfile_id=pg.pgfile_id AND 160 ts.chapter_id=tc.chapter_id AND 161 tc.textbook_id=tbk.textbook_id 162 $extrawhere $textextrawhere "; 163 #$query =~ s/\n/ /g; 164 #warn $query; 165 my $text_ref = $dbh->selectall_arrayref($query); 166 my @texts = @{$text_ref}; 167 if( $thing eq 'textbook') { 168 @texts = grep { $_->[1] =~ /\S/ } @texts; 169 my @sortarray = map { $_->[1] . $_->[2] . $_->[3] } @texts; 170 @texts = indirectSortByName( \@sortarray, @texts ); 171 return(\@texts); 172 } else { 173 @texts = grep { $_->[1] =~ /\S/ } @texts; 174 my @sortarray = map { $_->[0] .". " . $_->[1] } @texts; 175 @texts = map { [ $_ ] } @sortarray; 176 @texts = indirectSortByName(\@sortarray, @texts); 177 return(\@texts); 178 } 179 } 180 181 =item getAllDBsubjects($r) 182 Returns an array of DBsubject names 183 184 $r is the Apache request object 185 186 =cut 187 188 sub getAllDBsubjects { 189 my $r = shift; 190 my @results=(); 191 my $row; 192 my $query = "SELECT DISTINCT name FROM `NPL-DBsubject`"; 193 my $dbh = getDB($r->ce); 194 my $sth = $dbh->prepare($query); 195 $sth->execute(); 196 while ($row = $sth->fetchrow_array()) { 197 push @results, $row; 198 } 199 @results = sortByName(undef, @results); 200 return @results; 201 } 202 203 204 =item getAllDBchapters($r) 205 Returns an array of DBchapter names 206 207 $r is the Apache request object 208 209 =cut 210 211 sub getAllDBchapters { 212 my $r = shift; 213 my $subject = $r->param('library_subjects'); 214 return () unless($subject); 215 my $dbh = getDB($r->ce); 216 my $query = "SELECT DISTINCT c.name FROM `NPL-DBchapter` c, 217 `NPL-DBsubject` t 218 WHERE c.DBsubject_id = t.DBsubject_id AND 219 t.name = \"$subject\""; 220 my $all_chaps_ref = $dbh->selectall_arrayref($query); 221 my @results = map { $_->[0] } @{$all_chaps_ref}; 222 @results = sortByName(undef, @results); 223 return @results; 224 } 225 226 =item getAllDBsections($r) 227 Returns an array of DBsection names 228 229 $r is the Apache request object 230 231 =cut 232 233 sub getAllDBsections { 234 my $r = shift; 235 my $subject = $r->param('library_subjects'); 236 return () unless($subject); 237 my $chapter = $r->param('library_chapters'); 238 return () unless($chapter); 239 my $dbh = getDB($r->ce); 240 my $query = "SELECT DISTINCT s.name FROM `NPL-DBsection` s, 241 `NPL-DBchapter` c, `NPL-DBsubject` t 242 WHERE s.DBchapter_id = c.DBchapter_id AND 243 c.DBsubject_id = t.DBsubject_id AND 244 t.name = \"$subject\" AND c.name = \"$chapter\""; 245 my $all_sections_ref = $dbh->selectall_arrayref($query); 246 my @results = map { $_->[0] } @{$all_sections_ref}; 247 @results = sortByName(undef, @results); 248 return @results; 249 } 250 251 =item getDBSectionListings($r) 252 Returns an array of hash references with the keys: path, filename. 253 254 $r is an Apache request object that has all needed data inside of it 255 256 Here, we search on all known fields out of r 257 258 =cut 259 260 sub getDBListings { 261 my $r = shift; 262 my $amcounter = shift; 263 my $ce = $r->ce; 264 my $subj = $r->param('library_subjects') || ""; 265 my $chap = $r->param('library_chapters') || ""; 266 my $sec = $r->param('library_sections') || ""; 267 my $keywords = $r->param('library_keywords') || ""; 268 my ($kw1, $kw2) = ('',''); 269 if($keywords) { 270 $kw1 = ", `NPL-keyword` kw, `NPL-pgfile-keyword` pgkey"; 271 $kw2 = " AND kw.keyword_id=pgkey.keyword_id AND 272 pgkey.pgfile_id=pgf.pgfile_id ". 273 makeKeywordWhere($keywords) ; 274 } 275 276 my $dbh = getDB($ce); 277 278 my $extrawhere = ''; 279 if($subj) { 280 $subj =~ s/'/\\'/g; 281 $extrawhere .= " AND dbsj.name=\"$subj\" "; 282 } 283 if($chap) { 284 $chap =~ s/'/\\'/g; 285 $extrawhere .= " AND dbc.name=\"$chap\" "; 286 } 287 if($sec) { 288 $sec =~ s/'/\\'/g; 289 $extrawhere .= " AND dbsc.name=\"$sec\" "; 290 } 291 my $textextrawhere = ''; 292 my $haveTextInfo=0; 293 for my $j (qw( textbook textchapter textsection )) { 294 my $foo = $r->param(LIBRARY_STRUCTURE->{$j}{name}) || ''; 295 $foo =~ s/^\s*\d+\.\s*//; 296 if($foo) { 297 $haveTextInfo=1; 298 $foo =~ s/'/\\'/g; 299 $textextrawhere .= " AND ".LIBRARY_STRUCTURE->{$j}{where}."=\"$foo\" "; 300 } 301 } 302 303 my $selectwhat = 'DISTINCT pgf.pgfile_id'; 304 $selectwhat = 'COUNT(' . $selectwhat . ')' if ($amcounter); 305 306 my $query = "SELECT $selectwhat from `NPL-pgfile` pgf, 307 `NPL-DBsection` dbsc, `NPL-DBchapter` dbc, `NPL-DBsubject` dbsj $kw1 308 WHERE dbsj.DBsubject_id = dbc.DBsubject_id AND 309 dbc.DBchapter_id = dbsc.DBchapter_id AND 310 dbsc.DBsection_id = pgf.DBsection_id 311 \n $extrawhere 312 $kw2"; 313 if($haveTextInfo) { 314 $query = "SELECT $selectwhat from `NPL-pgfile` pgf, 315 `NPL-DBsection` dbsc, `NPL-DBchapter` dbc, `NPL-DBsubject` dbsj, 316 `NPL-pgfile-problem` pgp, `NPL-problem` prob, `NPL-textbook` tbk , 317 `NPL-chapter` tc, `NPL-section` ts $kw1 318 WHERE dbsj.DBsubject_id = dbc.DBsubject_id AND 319 dbc.DBchapter_id = dbsc.DBchapter_id AND 320 dbsc.DBsection_id = pgf.DBsection_id AND 321 pgf.pgfile_id = pgp.pgfile_id AND 322 pgp.problem_id = prob.problem_id AND 323 tc.textbook_id = tbk.textbook_id AND 324 ts.chapter_id = tc.chapter_id AND 325 prob.section_id = ts.section_id \n $extrawhere \n $textextrawhere 326 $kw2"; 327 } 328 #$query =~ s/\n/ /g; 329 #warn $query; 330 my $pg_id_ref = $dbh->selectall_arrayref($query); 331 my @pg_ids = map { $_->[0] } @{$pg_id_ref}; 332 if($amcounter) { 333 return(@pg_ids[0]); 334 } 335 my @results=(); 336 for my $pgid (@pg_ids) { 337 $query = "SELECT path, filename FROM `NPL-pgfile` pgf, `NPL-path` p 338 WHERE p.path_id = pgf.path_id AND pgf.pgfile_id=\"$pgid\""; 339 my $row = $dbh->selectrow_arrayref($query); 340 push @results, {'path' => $row->[0], 'filename' => $row->[1] }; 341 342 } 343 return @results; 344 } 345 346 sub countDBListings { 347 my $r = shift; 348 return (getDBListings($r,1)); 349 } 350 351 ############################################################################## 352 # input expected: keywords,<keywords>,chapter,<chapter>,section,<section>,path,<path>,filename,<filename>,author,<author>,instituition,<instituition>,history,<history> 353 # 354 # 355 # Warning - this function is out of date (but currently unused) 356 # 357 358 sub createListing { 359 my $ce = shift; 360 my %listing_data = @_; 361 my $classify_id; 362 my $dbh = getDB($ce); 363 # my $dbh = WeBWorK::ProblemLibrary::DB::getDB(); 364 my $query = "INSERT INTO classify 365 (filename,chapter,section,keywords) 366 VALUES 367 ($listing_data{filename},$listing_data{chapter},$listing_data{section},$listing_data{keywords})"; 368 $dbh->do($query); #TODO: watch out for comma delimited keywords, sections, chapters! 369 370 $query = "SELECT id FROM classify WHERE filename = $listing_data{filename}"; 371 my $sth = $dbh->prepare($query); 372 $sth->execute(); 373 if ($sth->rows()) 374 { 375 ($classify_id) = $sth->fetchrow_array; 376 } 377 else 378 { 379 #print STDERR "ListingDB::createListingPGfiles: $listing_data{filename} failed insert into classify table"; 380 return 0; 381 }; 382 383 $query = "INSERT INTO pgfiles 384 ( 385 classify_id, 386 path, 387 author, 388 institution, 389 history 390 ) 391 VALUES 392 ( 393 $classify_id, 394 $listing_data{path}, 395 $listing_data{author}, 396 $listing_data{institution}, 397 $listing_data{history} 398 )"; 399 400 $dbh->do($query); 401 return 1; 402 } 403 404 ############################################################################## 405 # input expected any pair of: keywords,<keywords data>,chapter,<chapter data>,section,<section data>,filename,<filename data>,author,<author data>,instituition,<instituition data> 406 # returns an array of hash references 407 # 408 # Warning - out of date (and unusued) 409 # 410 411 sub searchListings { 412 my $ce = shift; 413 my %searchterms = @_; 414 #print STDERR "ListingDB::searchListings input array @_\n"; 415 my @results; 416 my ($row,$key); 417 my $dbh = getDB($ce); 418 my $query = "SELECT c.filename, p.path 419 FROM classify c, pgfiles p 420 WHERE c.id = p.classify_id"; 421 foreach $key (keys %searchterms) { 422 $query .= " AND c.$key = $searchterms{$key}"; 423 }; 424 my $sth = $dbh->prepare($query); 425 $sth->execute(); 426 if ($sth->rows()) 427 { 428 while (1) 429 { 430 $row = $sth->fetchrow_hashref(); 431 if (!defined($row)) 432 { 433 last; 434 } 435 else 436 { 437 #print STDERR "ListingDB::searchListings(): found $row->{id}\n"; 438 my $listing = $row; 439 push @results, $listing; 440 } 441 } 442 } 443 return @results; 444 } 445 ############################################################################## 446 # returns a list of chapters 447 # 448 # Warning - out of date 449 # 450 451 sub getAllChapters { 452 #print STDERR "ListingDB::getAllChapters\n"; 453 my $ce = shift; 454 my @results=(); 455 my ($row,$listing); 456 my $query = "SELECT DISTINCT chapter FROM classify"; 457 my $dbh = getDB($ce); 458 my $sth = $dbh->prepare($query); 459 $sth->execute(); 460 while (1) 461 { 462 $row = $sth->fetchrow_array; 463 if (!defined($row)) 464 { 465 last; 466 } 467 else 468 { 469 my $listing = $row; 470 push @results, $listing; 471 #print STDERR "ListingDB::getAllChapters $listing\n"; 472 } 473 } 474 return @results; 475 } 476 ############################################################################## 477 # input chapter 478 # returns a list of sections 479 # 480 # Warning - out of date (and unused) 481 # 482 483 sub getAllSections { 484 #print STDERR "ListingDB::getAllSections\n"; 485 my $ce = shift; 486 my $chapter = shift; 487 my @results=(); 488 my ($row,$listing); 489 my $query = "SELECT DISTINCT section FROM classify 490 WHERE chapter = \'$chapter\'"; 491 my $dbh = getDB($ce); 492 my $sth = $dbh->prepare($query); 493 $sth->execute(); 494 while (1) 495 { 496 $row = $sth->fetchrow_array; 497 if (!defined($row)) 498 { 499 last; 500 } 501 else 502 { 503 my $listing = $row; 504 push @results, $listing; 505 #print STDERR "ListingDB::getAllSections $listing\n"; 506 } 507 } 508 return @results; 509 } 510 511 ############################################################################## 512 # returns an array of hash references 513 # 514 # Warning - out of date (and unused) 515 # 516 517 sub getAllListings { 518 #print STDERR "ListingDB::getAllListings\n"; 519 my $ce = shift; 520 my @results; 521 my ($row,$key); 522 my $dbh = getDB($ce); 523 my $query = "SELECT c.*, p.path 524 FROM classify c, pgfiles p 525 WHERE c.pgfiles_id = p.pgfiles_id"; 526 my $sth = $dbh->prepare($query); 527 $sth->execute(); 528 while (1) 529 { 530 $row = $sth->fetchrow_hashref(); 531 last if (!defined($row)); 532 my $listing = $row; 533 push @results, $listing; 534 #print STDERR "ListingDB::getAllListings $listing\n"; 535 } 536 return @results; 537 } 538 539 ############################################################################## 540 # input chapter, section 541 # returns an array of hash references. 542 # if section is omitted, get all from the chapter 543 sub getSectionListings { 544 #print STDERR "ListingDB::getSectionListings(chapter,section)\n"; 545 my $r = shift; 546 my $ce = $r->ce; 547 my $version = $ce->{problemLibrary}->{version} || 1; 548 if($version == 2) { return(getDBListings($r, 0))} 549 my $subj = $r->param('library_subjects') || ""; 550 my $chap = $r->param('library_chapters') || ""; 551 my $sec = $r->param('library_sections') || ""; 552 553 my $chapstring = ''; 554 if($chap) { 555 $chap =~ s/'/\\'/g; 556 $chapstring = " c.chapter = \'$chap\' AND "; 557 } 558 my $secstring = ''; 559 if($sec) { 560 $sec =~ s/'/\\'/g; 561 $secstring = " c.section = \'$sec\' AND "; 562 } 563 564 my @results; #returned 565 my $query = "SELECT c.*, p.path 566 FROM classify c, pgfiles p 567 WHERE $chapstring $secstring c.pgfiles_id = p.pgfiles_id"; 568 my $dbh = getDB($ce); 569 my $sth = $dbh->prepare($query); 570 571 $sth->execute(); 572 while (1) 573 { 574 my $row = $sth->fetchrow_hashref(); 575 if (!defined($row)) 576 { 577 last; 578 } 579 else 580 { 581 push @results, $row; 582 #print STDERR "ListingDB::getSectionListings $row\n"; 583 } 584 } 585 return @results; 586 } 587 588 ############################################################################### 589 # INPUT: 590 # listing id number 591 # RETURN: 592 # 1 = all ok 593 # 594 # not implemented yet 595 sub deleteListing { 596 my $ce = shift; 597 my $listing_id = shift; 598 #print STDERR "ListingDB::deleteListing(): listing == '$listing_id'\n"; 599 600 my $dbh = getDB($ce); 601 602 return undef; 603 } 604 605 606 # Use sortByName($aref, @b) to sort list @b using parallel list @a. 607 # Here, $aref is a reference to the array @a 608 609 sub indirectSortByName { 610 my $aref = shift ; 611 my @a = @$aref; 612 my @b = @_; 613 my %pairs ; 614 for my $j (1..scalar(@a)) { 615 $pairs{$a[$j-1]} = $b[$j-1]; 616 } 617 my @list = sortByName(undef, @a); 618 @list = map { $pairs{$_} } @list; 619 return(@list); 620 } 621 622 623 624 ############################################################################## 625 1; 626 627 __END__ 628 629 =head1 DESCRIPTION 630 631 This module provides access to the database of classify in the 632 system. This includes the filenames, along with the table of 633 search terms. 634 635 =head1 FUNCTION REFERENCE 636 637 =over 4 638 639 =item $result = createListing( %listing_data ); 640 641 Creates a new listing populated with data from %listing_data. On 642 success, 1 is returned, 0 is returned on failure. The %listing_data 643 hash has the following format: 644 =cut 645 646 =back 647 648 =head1 AUTHOR 649 650 Written by Bill Ziemer. 651 Modified by John Jones. 652 653 =cut 654 655 656 ############################################################################## 657 # end of ListingDB.pm 658 ##############################################################################
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |