#!/usr/bin/perl =pod =head1 NAME Biblio-Tk =head1 SYNOPSIS biblio-tk =head1 DESCRIPTION Biblio-Tk is (yet another) program to help manage bibliographic information. There are many different formats of bibliographic information, and a few versions of "free" or "open source" software to work with it. IMHO, the better free versions have a large universe of possible entry descriptions for kinds of data, which is partitioned into: required, optional and ignored. One thing I disagree with I these programs, is that some kind of citation key is a required part of a bibliographic database. There is indeed a useful reason to have some kind of unique index to attach to each record; but because there are multiple ways to write a citation key, this should not be a required item. Rather, a citation key should be generated from the data when exporting it, and it should correspond to the citation format wanted for that data. Another thing I noticed in these programs, is that the set of ignored was B difference between all entry types and the union of required and optional entry types. Finally, there is local information I want to attach to some or all bibliographic entries. Technical material may be part of continuing education, and it completion date should be tracked. It might be useful to partition entries into various interests. Most of the entries of bibliographic data are just strings, little or no analysis of structure is done. There are a few date components, and some positive integers. But for the most part everything is either a string, or something I've added, an array of strings. There were 2 types which to me seemed almost identical in intent: proceedings and conference. I've changed conference slightly, to make it more "book"-like. The original defintion of conference had an authors_ field, I've changed that to editors_, and made authors_ optional. I've added ISBN to both proceedings and conference as an optional field. According to BibTeX documentation, these were intended to be the same. I've decided to further change 'conference' to better describe the few conference proceedings I have (as complete collections of articles). I build hash keys from the required content, similar to how Citation keys are made. However, in the process of editing an entry, the values in the required fields may change, which (IMHO) changes the value of the hash key. So, one must be aware of this. Also, if you edit something like the Dumper output with an editor, and then reload the database; you may find the value of the hash key is different than it should be. So, on data import one must calculate the hash key, whether or not the import format uses a hash key or not. When one saves the data as Dumper or Storable, the hash key will be saved. If one goes to import this data, it would be eval'ed into $dbase, which is where it came out of. So, the thing to do is to locally rename $dbase to $DBase before importing data, and then copy structures from the new $dbase to $DBase. Having input 60 some odd books already, I would like to see the structure of the chapters_ part of optional change significantly. Instead of an array of strings (chapter titles), it should be: =begin text 'optional' => [... 'part_' => { ['part_title', 'pages', 'chapters_' => [ 'chapter_title', 'pages', 'section' => [ 'section_title', 'pages', 'sub_section' => [ 'subsection_title', 'pages', 'subsub_section' => [ 'subsub_title', 'pages', 'paragraph' => [ 'paragraph_title', 'pages', 'subparagraph' => [ 'subparagraph_title', 'pages' ], ], ], ], ], ], ], }, 'chapters_', =end text This is broken down as much as LaTeX does, and uses the same sectioning command names. I have seen multiple parts, with parts having useful names. It would be nice to have them in the database. I have seen useful sections and once or twice useful subsections, in a table of contents. I haven't seen the sectioning developed more than that (paragraph and subparagraph). I have seen a situation where the chapter titles were useless, but the section titles were useful. Why do I want this? Well, anything which can get sucked into a Table of Contents, should be fair game for a bibliography database. I want to be able to search it, to find books I have in my library that contain information on a topic. Appendices need to be there, and there should be a section for things like CD's. For now, it would just make both of these simple arrays of strings. For conference proceedings, we have a collection of articles that have authors (do any articles break down by sectioning?) and page ranges. Sometimes the article is there in support of a presentation, sometimes supporting a poster. Does it ever not support anything? Having had to stop and start a few times, I am glad that Tk allows one to cut and paste from emacs to the Tk widgets. The program as written, writes output to stdout fairly constantly. The first few times, I found that the Dumper output to screen was significantly different that the output to file (which lost a lot of information). So, just cutting and pasting from my xterm (actually the KDE konsole terminal) to an emacs session worked nicely to recover the pages of input I had entered. The konsole session is buffering about 8 book-type entries, which is a fair amount. It would be nice if the ROText widget used for displaying the array of authors, editors, chapters, I would leave the displayed information on the last 2 lines of the array, rather than the first two. It would be easier for keeping track of where you were during long data input sessions. =head2 Development I realised from the start, that this entire thing would be rather clunky as a command line interface program. And having used a couple versions of curses based toolkits in perl, I don't think using curses on a text console is going to be much fun. It would probably be just as usable, or almost as usable as this version which is designed for a graphical interface (X11). One of the earlier perl graphical interfaces, is the combination of Perl and Tk. This is a copy of the more well known combination of Tcl/Tk. There are other user interfaces available for X11 (and possibly Mac, Windows, ...). Since my immediate needs are to enter manually data from all the books I have in my personal library, the manual entry methods were worked on first. I haven't had a lot of practice in Perl/Tk, so there are bound to be places where I used a "strange" method to do things. =head2 Important Data There are a few data structures which the program revolves around. =begin text @field_types = ('required', 'optional', 'ignored', 'l_entry'); my %entries_list = ( article => { 'description' => ['An article from a published journal'], 'required' => ['authors_', 'journal', 'title', 'year'], 'optional' => ['abstract', 'affiliation', 'annote', 'citkey_', 'crossref', 'file', 'issn', 'key', 'month', 'note', 'number', 'pages', 'url', 'volume'], 'ignored' => [''], # What's left 'l_entry' => @l_entries, }, ... ); =end text and =begin text my %l_entry = ( My_Interest => 'What my interest in this bibliographic entry is', Topics_ => 'Array of topic areas this item covers', Status => 'Status??', Purchase_Date => 'When did I buy the item (if I bought it)', Purchase_Amount => 'How much did I pay for the item', Finish_Reading => 'When did I finish reading it (the first time)', ); =end text The list of keys of %entries_list is the types of bibliography information which can be stored, and is stored in @bib_types. The union of all required, optional and ignored entries, is known as @g_fields. It is entirely possible that in my explicit enumeration of @g_fields I have entry types which are not seen anywhere in %entries_list. %entries_list has the I field to help users decide what a particular bibliography type is for. I would like to change the @g_fields array into a hash which also contained descriptions of each field. If a person explicitly enumerated @g_fields, @bib_types, I, it would be possible to make a consistency check at program start-up. At the present time, this is just stub code which always returns 1 (true). The B field is often just left as a string, but I felt it is probably better off as an array of strings. One string per author. One set of reasons is that occasionally we get later editions of books, with the order of the authors shuffled, the addition of another author, the deletion of an author, I. I believe the only bibliographic type which always has a single author, is the thesis. For some reason, many other programs make a destinction between a Masters thesis and a Ph.D. thesis. The data contents are the same, so I merged the two. B is similar to authors. Other array types are: art_titles and chapters. Internally, an array data type is indicated by appending an underscore to the element name. When a subroutine is working with array data, it often sets up a temporary string variable without the underscore and leaves the the underscore with an array variable. Data entry will shuttle any remaining data on a string line entry to the array, before (possibly) accepting the set of data. This means it is possible for the user to type in all of the data as a string, but it would be preferred if they would input it as an array of strings. =cut # Hopefully something workable will result. :-) # # One of the easiest ways to keep a persistent data store (database) # of perl data, is MLDBM. It will flatten the perl structure using # some part of Storable (or Dumper or FreezeThaw), and then store it # in SDBM, GDBM, orther DBM, or DB_File (the Berkeley DB). The # recommended combination is now Storable and DB_File. Early MLDBM # had some strangeness to it, in that you had to copy entire trees # into RAM in order to make a change, and then copy the whole thing # back. Now, there is MLDBM::Sync to help with the RAM versus # disk behavior. # # Status: I now have a working manual input section, which gathers # required, optional and local information (it ignores the ignored # section of each type). The information is stored in a global # hash called $cache. # # The data after all parts are collected, is minimally copied to # a global hash. The key for the hash is built from required data # that has been "Squeezed" and then converted to a hexadecimal MD5 # hash. # # The global hash can be saved as Dumper output to a file. # # Dialog and DialogBox is tooooo sssssllllllloooooooooowwwwwww! # Todo: # 1) Data output to MLDBM #XXXXX 2) Data output to text file (dumper) # 3) Data output to text file, in format needed for resume inventory # 4) Data output to text file, as XML # 5) Initialisation of DBase via DBI # 6) Data output to DBase via DBI # 7) Exports via bp.pm # 8) Imports via bp.pm # 9) Expand Co. Inc. LLC etc. in some fields. Other abbreviations? # # I've seen much more complexity than any description is supposed to # handle. Including translators and appendices to chapters in books. # The following structure of a "section" should work: # section = ( # 'name => Part/Chapter/SubChapter/Appendix/... # 'title' => # 'authors_' => @( # 'name' => # 'affiliation' => # ), # 'editors_' => @( # 'name' => # 'affiliation' => # ), # 'translators_' => @( # 'name' => # 'affiliation' => # ), # 'section' => @section, # 'My_Interest' =>, # 'Topics_' => @topics # ), my $VERSION = "0.01"; #use Devel::AutoProfiler; use Tk; use Tk::ROText; use Tk::Dialog; use Tk::LabEntry; #use Tk::FileSelect; #use Tk::Balloon; use Data::Dumper; use subs qw/file_menuitems edit_menuitems help_menuitems/; # Define default GUI (Tk) environment my $ww = 80; # widget width # my $geometry = "887x637"; my $geometry = "692x729+1+1"; # my $fn = "9x15"; # font used for widgets my $fn = "7x13"; # font used for widgets my $fn = "6x12"; # font used for widgets my $sliderWidth = 11; # slider width in pixel # my $sliderWidth = 7; # slider width in pixel my $background1 = "grey20"; # my $background2 = "#00004f"; # highlighted item and status bar my $background3 = "red4"; # ERROR background of status bar my $background4 = "blue3" ; # select my $foreground1 = "blue3"; # my $foreground2 = "brown4"; # my $foreground3 = "red"; # required fields my $foreground4 = "green4"; # optional fields my $foreground5 = "black"; # other fields my $foreground6 = "yellow"; # highlighted item and status bar my $foreground7 = "white"; # ERROR foreground of status bar my $tinyWindow = 0 ; # tiny window for sixpack # Things in my database, which while of interest to me, aren't strictly # part of a bibliographic database. my %l_entry = ( My_Interest => 'What my interest in this bibliographic entry is', Topics_ => 'Array of topic areas this item covers', Status => 'Status??', Purchase_Date => 'When did I buy the item (if I bought it)', Purchase_Amount => 'How much did I pay for the item', Finish_Reading => 'When did I finish reading it (the first time)', Book_Type => 'Textbook, reference book, etc.', ); my @l_entries = keys( %l_entry ); # Types of entries here. Each type of entry (article, book, ...) has 5 # fields: description, required, optional, ignored and l_entry. Required, # optional and ignored are a partitioning of: %all_entries = ( 'abstract' => 'A summary of a treatise, book or statement', 'address' => 'Postal or legal location of person or entity', 'affiliation' => 'Organisation that person is associated with', 'annote' => 'A note, added by way of comment or explanation', 'appendices_' => 'Any named/titled appendices', 'art_titles_' => 'Titles of articles in the work', 'authors_' => 'Person(s) involved in writing the document', 'booktitle' => 'Title of the book document comes from', 'chapters_' => 'Header at the beginning of a logical section of book', 'citkey_' => 'Citation key(s)', 'code' => 'Not sure of definition in this context', 'comments' => 'Not sure of definition in this context', 'crossref' => 'A cross reference', 'edition' => 'Number associated with reprinting of document after revisions', 'editors_' => 'Person involved in editing a document', 'file' => 'Local file which contains copy', 'howpublished' => 'How was this document published', 'institution' => 'An organisation which isn\'t usually commercial', 'ISBN' => 'International Standard Book Number', 'ISSN' => 'International Standard Serial Number, for journals', 'journal' => 'A collection of documents, published regularly', 'key' => 'Citation key?', 'library' => 'What library was this document in?', 'month' => 'What month was this published in, usually for periodicals', 'note' => 'How is this different than annote?', 'number' => 'Number associated with document, usually a journal. Might represent number of month.', 'organization' => 'Another word for institution? Business?', 'orig_year' => 'Year of original copyright, for republishing', 'pages' => 'Number of pages in document, or range of pages within enclosure', 'print_year' => 'Year of current printing', 'project' => 'Was this document associated with a particular project?', 'publisher' => 'Who is the publisher of this copy?', 'school' => 'Usually a college or university', 'select' => 'Not sure of definition in this context', 'series' => 'Number associated with multiple printings', 'title' => 'Header of document or enclosure of collection', 'type' => 'In cases of thesis, Master\'s or Ph.D. Not sure about techreport. Annual?', 'url' => 'Uniform Resource Locator (link) to document on WWW, preferably home link.', 'volume' => 'Number associated with multiple printings', 'year' => 'Year of current copyright.', ); @g_fields = keys(%all_entries); # Description is a short description of the type of entry. The "required" # fields must be entered. Optional fields will be accepted. The "ignored" # field is itself optional, it is what is left of required and optional. # If ignored has contents, it should be complete. @field_types = ('required', 'optional', 'ignored', 'l_entry'); =pod =head2 @ignored data if the @ignored list is empty in %entries_list, it will be calculated if needed by the difference between @g_fields and the union of @required and @optional arrays. =head2 Element order in @required, @optional and @ignored The order in these lists, is the order they are shown in manual data entry. At present, they are in alphabetical order. =head2 Conference I Proceedings I do not know why these are both here, they appear to be the same kind of bibliographic data to me. =cut my %entries_list = ( article => { 'description' => ['An article from a published journal'], 'required' => ['authors_', 'journal', 'title', 'year'], 'optional' => ['abstract', 'affiliation', 'annote', 'appendices_', 'citkey_', 'crossref', 'file', 'ISSN', 'key', 'month', 'note', 'number', 'pages', 'url', 'volume'], 'ignored' => [''], # What's left 'l_entry' => @l_entries, }, book => { 'description' => ['A book with an explicit publisher, required authors or editors'], 'required' => ['authors_|editors_', 'publisher', 'title', 'year'], 'optional' => ['abstract', 'address', 'annote', 'appendices_', 'chapters_', 'citkey_', 'crossref', 'edition', 'ISBN', 'key', 'month', 'note', 'number', 'orig_year', 'pages', 'series', 'url', 'volume',], 'ignored' => [''], 'l_entry' => @l_entries, }, booklet => { 'description' => ['A work that is printed and bound, but without a named publisher or sponsoring institution'], 'required' => ['title'], 'optional' => ['address', 'affiliation', 'authors_', 'citkey_', 'file', 'howpublished', 'key', 'month', 'note', 'url', 'year'], 'ignored' => [''], 'l_entry' => @l_entries, }, sub_book => { 'description' => ['A part of a book, which may be a chapter and/or a range of pages; required authors or editors'], 'required' => ['authors_|editors_', 'chapters_', 'pages', 'publisher', 'title', 'year'], 'optional' => ['address', 'affiliation', 'citkey_', 'edition', 'file', 'key', 'month', 'note', 'series', 'url', 'volume'], 'ignored' => [''], 'l_entry' => @l_entries, }, incollection => { 'description' => ['A part of a book, having its own title'], 'required' => ['authors_', 'booktitle', 'title', 'year'], 'optional' => ['address', 'affiliation', 'chapters_', 'citkey_', 'editors_', 'file', 'ISBN', 'key', 'month', 'note', 'organisation', 'pages', 'publisher', 'url'], 'ignored' => [''], 'l_entry' => @l_entries, }, inproceedings => { 'description' => ['An article in a conference proceedings'], 'required' => ['authors_', 'booktitle', 'title', 'year'], 'optional' => ['address', 'affiliation', 'citkey_', 'editors_', 'file', 'key', 'month', 'note', 'organisation', 'pages', 'publisher', 'url'], 'ignored' => [''], 'l_entry' => @l_entries, }, proceedings => { 'description' => ['The proceedings of a conference'], 'required' => ['title', 'year'], 'optional' => ['abstract', 'address', 'annote', 'art_titles_', 'citkey_', 'crossref', 'editors_', 'file', 'ISBN', 'key', 'month', 'note', 'number', 'organisation', 'publisher', 'series', 'url', 'volume', 'year'], 'ignored' => [''], 'l_entry' => @l_entries, }, conference => { 'description' => ['Something different, but the same, as a conference proceedings?'], 'required' => ['booktitle', 'editors_', 'year'], 'optional' => ['authors_', 'address', 'art_titles_', 'file', 'ISBN', 'key', 'month', 'note', 'organisation', 'pages', 'publisher'], 'ignored' => [''], 'l_entry' => @l_entries, }, manual => { 'description' => ['Technical documentation'], 'required' => ['title'], 'optional' => ['abstract', 'address', 'affiliation', 'annote', 'authors_', 'citkey_', 'crossref', 'editors_', 'edition', 'file', 'key', 'month', 'note', 'organisation', 'url', 'year'], 'ignored' => [''], 'l_entry' => @l_entries, }, thesis => { 'description' => ['A Ph.D./Sc.D./M.Sc./M.S./M.Eng./... thesis'], 'required' => ['authors', 'school', 'title', 'type', 'year'], 'optional' => ['abstract', 'address', 'affiliation', 'annote', 'appendices_', 'chapters_', 'citkey_', 'crossref', 'file', 'key', 'month', 'note', 'url'], 'ignored' => [''], 'l_entry' => @l_entries, }, techreport => { 'description' => ['A report published by a school or other institution, usually numbered within a series'], 'required' => ['authors_', 'institution', 'title', 'year'], 'optional' => ['abstract', 'address', 'annote', 'citkey_', 'crossref', 'file', 'key', 'month', 'note', 'number', 'type', 'url'], 'ignored' => [''], 'l_entry' => @l_entries, }, unpublished => { 'description' => ['A document having an author and title, but not formally published'], 'required' => ['authors_', 'note', 'title'], 'optional' => ['abstract', 'annote', 'citkey_', 'crossref', 'file', 'key', 'month', 'url', 'year'], 'ignored' => [''], 'l_entry' => @l_entries, }, misc => { 'description' => ['Use this if nothing else fits'], 'required' => [''], 'optional' => ['authors_', 'citkey_', 'file', 'howpublished', 'key', 'month', 'note', 'title', 'url', 'year'], 'ignored' => [''], 'l_entry' => @l_entries, }, ); @bib_types = sort keys(%entries_list); my($progname); # Our welcome message. All one line, so that window will display it nicely. my $welcome = ''; $welcome .= "A program designed to store/edit/manipulate "; $welcome .= "bibliography data, along with local information which "; $welcome .= "isn't necessarily bibliography related. Hopefully enough "; $welcome .= "information is stored, that various standard bibliography "; $welcome .= "formats can be imported and exported.\n\n\n\n"; $welcome .= "The kinds of bibliography data are: "; $welcome .= join ', ', @bib_types; $welcome .= ".\n\nThe bibliography fields allowed are "; $welcome .= join ', ', @g_fields; $welcome .= ".\n\nAnd the kinds of local data are: "; $welcome .= join ', ', @l_entries; $welcome .= ".\n\nFor any given type of bibliography data, the fields are "; $welcome .= "one of: "; $welcome .= join ', ', @field_types; $welcome .= "."; #$welcome .= " "; sub myexit { return 1; } # Process Command Line. # init DBase $gui = 1; my $cache = {}; my $dbase = {}; # In RAM copy of database if( $gui ) { &guiMain(); &myexit; exit 0; } else { print "\n$progname $VERSION\n"; cmdMain(); } my( $mw, $listWin, $Balloon ); my $balloonOn=(1==1); my( $mainFrame, $mainCanvas, $statusLabel, $statusDummyLabel ); my( %menu, @buttonList, @buttonXpm ); my $listText; #...... sub guiMain { $ui = 'gui'; # Bunch of status variables # Allow the user to set X11 options on the command line, like: # -background, -foreground, -display, -font, -geometry # Tk::CmdLine::SetArguments strips stuff from @ARGV to do this. # Tk implicitly calls SetArguments when MainWindow created. # Tk::CmdLine::LoadResources will load from file. $mw = MainWindow->new(); # We could define an icon for our program, to be used for minimizing # $mw->iconimage( $mw->Pixmap(-file=>"path/to/icon.xpm") ); # So, with making our MainWindow, we implicitly import a whole # bunch of User Interface type information. We may want to define # other information, and so we need to find out what things are # already defined. if( defined( $mw->optionGet('font','') ) ) { $UIDefines->{font} = $mw->optionGet('font',''); } if( defined( $mw->optionGet('sliderWidth','') ) ) { $UIDefines->{sliderWidth} = $mw->optionGet('sliderWidth',''); } foreach my $name ( 'background1', 'background2', 'background3', 'background4', 'foreground1', 'foreground2', 'foreground3', 'foreground4', 'foreground5', 'foreground6', 'foreground7' ) { if( defined( $mw->optionGet($name,'') ) ) { my $colour = $mw->optionGet($name,''); # I guess colours can have leading/trailing space. Strip it. $colour =~ s/^\s+//; $colour =~ s/\s+$//; $UIDefines->{$name} = $colour; } } if( defined( $mw->optionGet('geometry','') ) ) { $userDefines->{geometry} = $mw->optionGet('geometry',''); } # Set up our MainWindow $mw->wm('title', 'Biblio-Tk'); $mw->wm('iconname', 'Biblio-Tk'); $mw->wm('geometry', $geometry ? $geometry : $UIDefines->{geometry} ); =pod =head2 Tk Menus I do not understand all the hype behind the "new" way of setting up pulldown menus, or the older ways. I've followed examples from various places, and still got non-functioning or strangely functioning menus. I think that someone should proeprly document just what is needed. One thing I found out, which I haven't seen documented, is that if your command is pointed to by \&subroutine, it B have any argument to it. If it does, the command runs immediately upon running the program. You must use the anonymous subroutine method of sub { &subroutine( @args ); =cut #$mw->Menubutton(-text => "Psuedo menubar", -menuitems => $Nmenuitems)->pack; # $menubar = $mw->Menu(-menuitems => $Nmenuitems); # $mw->configure(-menu => my $menubar = $mw->Menu(-menuitems => $Nmenuitems) ); $mw->configure( -menu => my $menubar = $mw->Menu ); $mw_menu{File} = $menubar->cascade( -label => '~File', -menuitems => file_menuitems ); $mw_menu{Edit} = $menubar->cascade( -label => '~Edit', -menuitems => edit_menuitems ); $mw_menu{Help} = $menubar->cascade( -label => '~Help', -menuitems => help_menuitems ); $mw->Label( -text => "$progname", -font => "9x15" )->pack(); $mw_text1 = $mw->ROText(-wrap=>'word', -relief=>'flat', -font=>'9x15')->pack(); $mw_text1->insert( 'end', $welcome ); $mw->Button(-text => 'Quit', -command => sub { $mw->destroy(); } )->pack; # Bind a Destroy function # $mw->bin('', [sub{exitIfUnmod(); $mw->break();}] ); # Go into our endless loop, processing events. MainLoop; # We jump to here, after calling destroy on our main window. print "All done!\n"; } # If you call a command from a menu, it CANNOT have any arguments if # it is like: # [qw/command ~New -command/ => \&GUI_New_DBase], # If it has argument, it must be like: # [qw/command ~Dumper -command/ => sub { &GUI_Save('Dumper'); }], sub file_menuitems { [ [qw/command ~New -command/ => \&GUI_New_DBase], [qw/cascade ~Save -menuitems/ => [ [qw/command ~Dumper -command/ => sub { &GUI_Save('Dumper'); }], [qw/command ~Storable -command/ => sub { &GUI_Save('Storable'); }], ] ], [qw/cascade ~Import -menuitems/ => [ [qw/command ~Dumper -command/ => sub { &GUI_Import('Dumper'); }], [qw/command ~Storable -command/ => sub { &GUI_Import('Storable'); }], ] ], [qw/command ~Quit -command/ => sub { $mw->destroy(); } ] ]; } sub edit_menuitems { [ ['command', 'Add', -command => \&GUI_Add_Entry], ]; } sub help_menuitems { [ ['command', 'Version', -command => sub {print "Version\n"}], ]; } sub GUI_New_DBase { print "Not yet, sorry\n"; } =pod =head2 GUI_Add_Entry Perl/Tk Dialog and DialogBox are both very slow to display. For a function which displays a bunch of buttons in order to provide an argument to &GUI_get_variables(), it is excessively long. =cut sub GUI_Add_Entry { my $default_button = 'book'; unless( grep /^$default_button$/, @bib_types ) { print "Can't find my default button in bib_types\n"; } my $answer = $mw->Dialog( -title => 'Biblio-Tk: Add New Bibliography Entry', -text => 'Choose which type of entry you are making.', -default_button => $default_button, -buttons => [@bib_types] )->Show(); foreach my $bib_type (@bib_types) { if( $answer eq $bib_type ) { &GUI_get_variables( $bib_type ); } } } =pod =head2 GUI_get_variables( $bib_type ) This is a wrapper around &GUI_get_subset_variable( ... ). It calls &getEditFields to find the @required, @optional, @ignored entry types for this $bib_type. It then calls &GUI_get_subset_variable( ... ) with one of @required, @optional or @l_entries, the $bib_type and a string indicating what the array of entries is (for @required, we want to verify that we get enough data). If the input of @required data goes completely, we call for @optional and @l_entries data to be input. We don't care as to whether the user "Finishes" or "Quits" from those. We save the data (copy from cache) and empty the $cache. If the user "Quit" from the required data part, just empty the $cache and return. I need to pass in $bib_type on first call to GUI_get_subset_variables(), since the bib_type has only just been set by the user in GUI_Add_Entry. Since I call GUI_get_subset_variable() twice more to get the @optional and @l_entries information, I pass in $bib_type even though it is formally part of the $cache now. For save_cache(), I no longer need $bib_type. =cut sub GUI_get_variables { my $bib_type = shift; # Find out what fields are required, and which are optional. Don't forget # the @l_entries, for local information. my ($required, $optional, $ignored) = &getEditFields( $bib_type ); print "Required=$#{$required} Optional=$#{$optional}\n"; if( &GUI_get_subset_variable( $bib_type, $required, 'Required' ) ) { $cache->{bib_type} = $bib_type; &GUI_get_subset_variable( $bib_type, $optional, 'Optional' ); &GUI_get_subset_variable( $bib_type, \@l_entries, 'Local_Entries' ); &save_cache(); &empty_cache(); } else { &empty_cache(); } } =pod =head2 GUI_get_variables( $bib_type ) This is a fairly complete facility for inputting data, and probably has a lot in common with displaying saved data and editing existing data. It is divided into a few parts. =item 1 Loop over all the entries for the array passed in (@subset), and make sure we either have empty strings or empty arrays in all those places in the cache. Copy the names of any array fields (minus the trailing underscore) to the @text_frames array. Create an ordinary (empty) string variable for "scratch" space (copying individual entries to the array). In the case of choices between different entry types (authors|editors), we need to split a single field into multiple sub_fields. Keep track of all the fields (not the scratch fields) which get touched in this initialisation step. Then we don't have to parse the @subset information over and over again for options (|) and arrays(_). =cut # ***********!!!!!!!!!!!!!!!!!!!!!!!! #When it comes to editing, if we edit an entry we must recalculate the #hash used to index the entry. We might have changed some of the data which #goes into the hash value (it needs to once anyway). sub GUI_get_subset_variable { my $bib_type = shift; my $subset = shift; my $description = shift; my( $verified, @text_frames, %line_frame, %insert, $action, @cache_keys ); print "Hello, in GUI_get_subset_variables\n"; print "Working with $#{$subset} variables\n"; foreach my $field (@{$subset}) { if( $field =~ /\|/ ) { my @sub_fields = split( /\|/, $field ); foreach my $sub_field (@sub_fields) { push( @cache_keys, $sub_field ); if( $sub_field =~ /_$/ ) { my $name = $sub_field; $name =~ s/_$//; push( @text_frames, $name ); if( exists( $cache->{$sub_field} ) ) { if( ref( $cache->{$sub_field} ) eq 'ARRAY' ) { $#{$cache->{$sub_field}} = -1; } else { die "Programmer error. cache->{$sub_field} expected to be ARRAY\n"; } } else { $cache->{$sub_field} = []; } $cache->{$name} = ''; # unless( exists( $cache->{$name} ) ); } else { $cache->{$sub_field} = ''; # unless( exists( $cache->{$sub_field} ) ); } } # End loop over @sub_fields } else { push( @cache_keys, $field ); if( $field =~ /_$/ ) { my $name = $field; $name =~ s/_$//; push( @text_frames, $name ); if( exists( $cache->{$field} ) ) { if( ref( $cache->{$field} ) eq 'ARRAY' ) { $#{$cache->{$field}} = -1; } else { die "Programmer error. cache->{$field} expected to be ARRAY\n"; } } else { $cache->{$field} = []; } $cache->{$name} = ''; # unless( exists( $cache->{$name} ) ); } else { $cache->{$field} = ''; # unless( exists( $cache->{$field} ) ); } } # End of if( field has pipe symbol in it ) } # End loop over @subset variables for entry =pod =item 2 If we have arrays, we need 3 buttons for our Dialog, otherwise we need 2. Build the top of the DialogBox. =cut # Build a DialogBox for the user to enter data. We enter the data into a # single hash that we keep for current data. We copy this data over to # an hash (or something) when we save it. if( @text_frames ) { @buttons = ('Finished - Add', 'Add to Arrays', 'Quit'); } else { @buttons = ('Finished - Add', 'Quit'); } my $AddBox = $mw->DialogBox( -title => 'Biblio-Tk: Add Book Entry', -buttons => [@buttons], -default_button => 'Finished - Add' ); my $purpose = "$description Information"; $AddBox->Label( -textvariable => \$purpose )->pack(); =pod =item 3 Now we iterate over all the entry types input. We only need to watch out for array types, due to bulding @cache_keys above. For an array field, we want to add a horizontal frame with a label on the left and a Read-Only Text field on the right. This ROText field will hold the sum of array information input. If this sum is less than the width of the field, it will be displayed as a single line with separating entries. If it is longer than this, you will only see 2 lines of a vertical arrangement of entries. You can put the cursor in that field and use the keyboard arrows to scroll through the entries. Also with the array data type, we put below the Label/ROText frame, another frame which contains a label and an entry widget. This is where the user will input information. Normally, the user is expected to press the middle button after each entry, to shuttle the data into the ROText widget display, and also pushed to the array in the $cache. If the entry field contains data when the user is finished entering data for this set, this data will be shuttled into the array. In the case of scalar data, only a single horizontal frame containing a label and an entry field will be added to the DialogBox. =cut foreach my $field (@cache_keys) { if( $field =~ /_$/ ) { # Array type # Build string/Entry without _ ($name), and # array/Text ($field) with _ my $name = $field; $name =~ s/_$//; ($line_frame{$field}, $insert{$name}) = &add_label_text( $AddBox, $field, 30, 80 ) unless( exists( $line_frame{$field} ) ); $line_frame{$name} = &add_label_entry( $AddBox, $field, 30, 80 ) unless( exists( $line_frame{$name} ) ); } else { # Scalar field $line_frame{$field} = &add_label_entry( $AddBox, $field, 30, 80 ) unless( exists( $line_frame{$field} ) ); } } =pod =item 4 Data entry - We show the DialogBox with all its frames and buttons. There are 3 possible actions to take once the user hits one of the buttons. If the user is done inputting data, we go to the first branch. First, we shuttle any entry data to the parallel array, if any present. If this set of data is 'Required', we then verify that enough data is present. If verification is called for, and not enough data is present, warn the user. The $verified variable will be set to force another trip through the data entry window. If the action requested is to add (shuttle) data from the entry window to the array, do that. Set $verified to cause a return to the data entry window. If the action requested is to quit, go through the part of the cache used this time, and empty strings and arrays of contents. =cut $verified = 0; while( $verified == 0 ) { # Make the Box visible, and get the user input. $action = $AddBox->Show(); if( $action eq 'Finished - Add' ) { # User might want us to shuttle data. &shuttle_to_array(\@text_frames, \%insert); if( $description eq 'Required' ) { $verified = &verify_required( $subset, \@cache_keys ); unless( $verified == 1 ) { my $Warn = $mw->Dialog( -title => 'Error!', -text => 'Not all required fields have data.', -default_button => 'Continue', -buttons => ['Continue'] )->Show(); $Warn = ''; # Ignore return. } } else { $verified = 1; } } elsif( ($action eq 'Add to Arrays') && (@text_frames) ) { &shuttle_to_array(\@text_frames, \%insert); $verified = 0; } elsif( $action eq 'Quit' ) { # Does user want us to forget this info? If so, delete any @subset # info in the cache. No undelete! We really shouldn't have to check # for existance (they should all be there). foreach my $field (@cache_keys) { if( $field =~ /_$/ ) { my $name = $field; $name =~ s/_$//; $cache->{$name} = ''; # if( exists( $cache->{$name} ) ); $#{$cache->{$field}} = -1; } else { $cache->{$field} = ''; # if( exists( $cache->{$sub_field} )); } } $verified = 1; } } =pod =item 5 End of subroutine. If the user exited indicating they were finished entering data, return a 1. Otherwise (Quit) and return a 0. =cut return $action eq 'Finished - Add' ? 1 : 0; } =pod =head2 &verify_required We need to work with @required and @cache_keys here. We require string length (after tidying up the spaces business (elsewhere in shuttle) for every "entry" in @required. For entries containing a pipe (|), we have more than one element to look in. However, only 1 of those needs to hold string length. If more than 1 does, that's fine. In the case of array data types, we need to look in the array for number of elements (no elements means no string length) and string length. Suck up the entire array with join, using an empty string to append elements. =cut sub verify_required { my $required = shift; my $cache_keys = shift; my $verified = 1; # Clean up cache. Suck up leading and trailing space. Convert # multiple space to single space. If this results in a field which # is empty, delete it. # my @cache_keys = keys( %{$cache} ); # foreach my $key (@cache_keys) { # Done in shuttle # $cache->{$key} =~ s/^\s+//; # $cache->{$key} =~ s/\s+$//; # $cache->{$key} =~ s/\s+/ /g; # } # Look through the cache, to see that the required fields are filled in. foreach my $field (@{$required}) { my $str = ''; if( $field =~ /\|/ ) { my @sub_fields = split( /\|/, $field ); foreach my $sub_field (@sub_fields) { if( ref( $cache->{$sub_field} ) eq 'ARRAY' ) { if( @{$cache->{$sub_field}} ) { $str .= join '', @{$cache->{$sub_field}}; } } else { $str .= "$cache->{$sub_field}"; } } # End loop over @sub_fields $verified = 0 if( length( $str ) < 1 ); } else { # No @sub_fields if( ref( $cache->{$field} ) eq 'ARRAY' ) { if( @{$cache->{$field}} ) { $str .= join '', @{$cache->{$field}}; } } else { $str .= "$cache->{$field}"; } $verified = 0 if( length( $str ) < 1 ); } } return $verified; } =pod =head2 &add_label_entry() There is a similar function in Perl/Tk, but I can't see how I can get fixed widthe labels with it. A little playing around with the label inserted, in the case that this Label/Entry is involved with an array. =cut sub add_label_entry { my $widget = shift; my $field = shift; my $label_width = shift; my $entry_width = shift; # As far as arrays go, I don't want to display the trailing underscore # in the label. Might as well leave it for the field name. my $label; if( $field =~ /_$/ ) { $field =~ s/_$//; $label = "One of $field"; } else { $label = $field; } # Put in a frame, put a label on the left and an entry on the # right. Hopefully, this gets us what I want. Why LabEntry # won't let us pick a constant width for the label field, ?????? my $frame = $widget->Frame; $frame->Label( -text => "$label :", -width => $label_width )->pack(-side => 'left' ); $frame->Entry( -textvariable => \$cache->{$field}, -width => $entry_width )->pack(-side => 'left' ); $frame->pack(); return $frame; } =pod =head2 &add_label_text() Similar to above, but use a ROText widget. We need to return a reference to the ROText widget, so that we can update its contents. =cut sub add_label_text { my $widget = shift; my $field = shift; my $label_width = shift; my $entry_width = shift; # As far as arrays go, I don't want to display the trailing underscore # in the label. Might as well leave it for the field name. my $label = $field; $label =~ s/_$//; # Put in a frame, put a label on the left and an entry on the # right. Hopefully, this gets us what I want. Why LabEntry # won't let us pick a constant width for the label field, ?????? my $frame = $widget->Frame; $frame->Label( -text => "$label :", -width => $label_width )->pack(-side => 'left' ); my $text = $frame->ROText( -width => $entry_width, -height => 2, -relief => 'flat' )->pack(-side => 'left' ); $frame->pack(); return( $frame, $text ); } =pod =head2 &save_cache() We are going to copy (actually clone) the data from the $cache, to our $dbase. Since our $dbase is a hash, we need a hash key to use in making the copy. We generate a hash key from the @required entries, which is why we need the $bib_type. Normally, a B is built from a subset of @required data, so this is similar in intent. In the event we get a hash key collision (trying to save an entry which has the same key as something already in the $dbase), we start appending ":%d" (a colon and a number) to the hash, and then we look for a key collision again. Repeat until we get no more collisions. The colon is added in gen_hash, all we pass in is the number. We are assuming that collisions result from somehow the same key being generated from different data. This should be unlikely, but see the description of &gen_hash() for more information. We can save data as the Dumper output (which can be 'eval'ed back into perl quite easily) or Storable (which is binary, I'm using the portable network order version). I originally tried this using the Clone.pm function, which segfaulted all the time. Then I tried my own Clone, which either isn't doing the job or Data::Dumper isn't working. I then rebuilt Clone.pm with my current C compiler (there have been changes lately), and it still segfaults. Then I decided to use the dclone function from Storable.pm, which works. =cut sub save_cache { use Storable qw(dclone); # My own clone, and Clone.pm don't work. print "Called save_cache()\n"; print Dumper( $cache ); $extra = undef; $k = 0; while ( ! ($hash = &gen_hash( $dbase, $cache, $extra )) ) { $k++; $extra = sprintf "%d", $k; } print "We had $k name collisions with current dbase\n"; $dbase->{$hash} = dclone( $cache ); print Dumper( $dbase->{$hash} ); } =pod =head2 &my_clone() For some reason, the perl Clone.pm module was seg-faulting. So, I rolled my own. Pretty easy, as the structure isn't deep or complicated. Just scalars and arrays of scalars. Pretty easy, except for some reason it didn't work. Oh well, there's always more than one way to do it (used dclone from storable). =cut sub my_clone { my $dbase = shift; my $hash = shift; my $cache = shift; # my $ret = {}; $dbase->{$hash} = {}; foreach my $key (keys(%{$cache})) { if( ref( $cache->{$key} eq 'ARRAY' ) ) { if( $#{$cache->{$key}} > -1 ) { # my $rarray = []; $dbase->{$hash}{$key} = []; foreach my $val (@{$cache->{$key}}) { $val =~ s/^\s+//; $val =~ s/\s+$//; $val =~ s/\s+/ /; print " val=($val)\n"; # push @{$rarray}, $val if( length( $val ) > 0 ); push @{$dbase->{$hash}{$key}}, $val if( length( $val ) > 0 ); } print "rarray has $#{$dbase->{$hash}{$key}}\n"; # push @{$rarray}, @{$cache->{$key}} if( @{$cache->{$key}} ); # $ret->{$key} = $rarray if( $#{$rarray} > -1 ); } } else { # Just a string. my $str = $cache->{$key}; $str =~ s/^\s+//; $str =~ s/\s+$//; $str =~ s/\s+/ /; $dbase->{$hash}{$key} = $str if( length( $str ) > 0 ); } } # return( $ret ); } sub empty_cache { print "Called delete_cache()\n"; foreach my $key (keys(%{$cache})) { if( ref( $cache->{$key} ) eq 'ARRAY' ) { $#{$cache->{$key}} = -1; } else { $cache->{$key} = ''; } } } sub shuttle_to_array { my $text_frames = shift; my $insert = shift; foreach my $text_frame (@{$text_frames}) { # Build our array variable (append _). Attempt to # build a single line version (less than 80 chars). my $name = $text_frame . '_'; # Condition our temporary string version. $cache->{$text_frame} =~ s/^\s+//; $cache->{$text_frame} =~ s/\s+$//; $cache->{$text_frame} =~ s/\s+/ /g; # Append to array (if it has length), and set scalar string to '' if( length( $cache->{$text_frame} ) > 0 ) { push( @{$cache->{$name}}, $cache->{$text_frame} ); $cache->{$text_frame} = ''; } my $str = join ', ', @{$cache->{$name}}; if( length( $str ) > 79 ) { $str = join "\n", @{$cache->{$name}}; } $insert->{$text_frame}->delete("1.0",'end' ); $insert->{$text_frame}->insert('end', $str ); $insert->{$text_frame}->see('end'); # icursor not in ROText } } sub GUI_Save { my $save_type = shift; my $fname = $mw->getSaveFile(); if( $fname ) { if( $save_type eq 'Dumper' ) { unless( -e $fname ) { if( open( SAVE, "> $fname" ) ) { # print SAVE Dumper( $dbase ); { # Grrr. Dumper prints $cache to screen just fine, but # every time I look at SAVE, I find problems! Setting # Purity to 1 should guarantee that the 'eval'd object # has the same structure as what is in RAM when I saved # it. Setting Deepcopy to 1 will enable deep copying of # complicated structures. It shouldn't be needed here, # but turn it on anyway. I shouldn't have to set Deepcopy # to 0 (which would infinity actually), since setting Purity # to 1 causes this to act as if it was 0. Dumper output # from dclone copies seems to work fine. Yipee! local $Data::Dumper::Purity = 1; local $Data::Dumper::Deepcopy = 1; eval print SAVE Data::Dumper->Dump( [$dbase], [qw(dbase)] ); } # $dbase = eval( ); # Sort of thing. close( SAVE ); } else { print "oops\n"; } } else { print "File exists, skipping\n"; } # End of Dumper saving } elsif( $save_type eq 'Storable' ) { unless( -e $fname ) { use Storable qw(nstore_fd); # the portable store_fd version if( open( SAVE, "> $fname" ) ) { nstore_fd $dbase, \*SAVE; # $dbase = fd_retreive( \*SAVE ); # sort of thing. close( SAVE ); } else { print "oops\n"; } } else { print "File exists, skipping\n"; } # End of Dumper saving } } } sub GUI_Save_As { return; } sub GUI_Import { my $import_type = shift; my $fname = $mw->getOpenFile(); if( $fname ) { if( $import_type eq 'Dumper' ) { if( -e $fname ) { if( open( IMPORT, "< $fname" ) ) { my $file; { # Read entire file into $file local $/; $file = ; } close(IMPORT); &do_dumper_import( $dbase, \$file ); } else { print "Strange, can't open file $fname\n"; } } else { print "Strange, file $fname doesn't exist, skipping\n"; } # End of Dumper saving } elsif( $import_type eq 'Storable' ) { # I used the network order store function. Only saving needs # to know if you want to use network order. Here I just call # retrieve. if( -e $fname ) { do_storable_import( $dbase, $fname ); } else { print "File doesn't exist, skipping\n"; } } } } =pod =head2 do_dumper_import Calling the do_dumper_import function from calling the Menu -> Import -> Dumper function seems to work. And it notices when any edits in the Dumper output have been edited in such a way that they result in a change in the hash value of the data imported. Programmatically, the has key used to input these biblio entries, is the new one calculated. The user is just informed (via STDOUT at present) that it noticed a change in the @required data leading to a different hash value. On writing this function, I noticed that I really needed to add to each biblio entry (and $cache), the identity of the biblio entry. Since all data entered to date in setting this up was 'book', I just assumed that any input data not containing $cache->{bib_type} was of type 'book'. Saving the data after importing it, resulted in bib_type being added to all records. As it should be. With this change, I can remove $bib_type from many parameters calls, as the data is in the global $cache which is accessed by many routines. The subroutine gen_hash() had to be edited to explicitly pass $cache (reference to an anonymous hash), and a few routines routines explicitly pass a reference to the RAM $dbase. =cut sub do_dumper_import { my $DBase = shift; # Reference to $dbase in "global" memory, hidden here. my $rfile = shift; my $dbase = {}; if( $$rfile =~ /^\$dbase = {/ ) { print "Seen proper beginning\n"; # Bring $dbase into RAM my $res = eval $$rfile; foreach my $ohash (keys( %{$dbase} )) { # Get a clone of this record. Set a default bib_type if need be. my $cache = {}; $cache = dclone( $dbase->{$ohash} ); my $bib_type = 'book'; if( exists( $cache->{bib_type} ) && $cache->{bib_type} ) { $bib_type = $cache->{bib_type}; } $cache->{bib_type} = $bib_type; # Generate a hash key for this entry, using our prexisting DBase # as the check for existance. my $k = 0; my $extra = undef; my $nhash; while ( ! ($nhash = &gen_hash( $DBase, $cache, $extra )) ) { $k++; $extra = sprintf "%d", $k; } if( $ohash ne $nhash ) { print "Adding data of $ohash with $nhash\n"; } $DBase->{$nhash} = dclone( $cache ); } } else { print "Strange, file doesn't begin properly (\$dbase = \{)\n"; } } sub do_storable_import { my $DBase = shift; my $fname = shift; my $dbase = {}; $dbase = retrieve( $fname ); foreach my $ohash (keys( %{$dbase} )) { # Get a clone of this record. Set a default bib_type if need be. my $cache = {}; $cache = dclone( $dbase->{$ohash} ); my $bib_type = 'book'; if( exists( $cache->{bib_type} ) && $cache->{bib_type} ) { $bib_type = $cache->{bib_type}; } $cache->{bib_type} = $bib_type; # Generate a hash key for this entry, using our prexisting DBase # as the check for existance. my $k = 0; my $extra = undef; my $nhash; while ( ! ($nhash = &gen_hash( $DBase, $cache, $extra )) ) { $k++; $extra = sprintf "%d", $k; } if( $ohash ne $nhash ) { print "Adding data of $ohash with $nhash\n"; } $DBase->{$nhash} = dclone( $cache ); } } sub consistent { return 1; } #($required, $optional, $other, $err_no) = &getEditFields( $type ); # Need to make unique ID. CiteID? # Auth1[AuthN]Yr sub getEditFields { my $type = shift; my $required = []; my $optional = []; my $ignored = []; $seen = 0; foreach $key (@bib_types) { # A publication can only be a single type. An entry in an article # type may be complex (but not of interest here). $seen++ if( $type eq $key ); } if( $seen == 0 ) { # Illegal bib_type return( undef, undef, undef, 1 ); } elsif( $seen > 1 ) { # Repeated bib_type?? return( undef, undef, undef, 2 ); } push( @{$required}, @{$entries_list{$type}{required}} ); push( @{$optional}, @{$entries_list{$type}{optional}} ); if( $#{$entries_list{$type}{ignored}} > -1 ) { push( @{$ignored}, @{$entries_list{$type}{ignored}} ); } else { # Build list manually. More work needed here. foreach $key (@g_fields) { push( @{$ignored}, $key ); } } return( $required, $optional, $ignored, 0 ); } BEGIN { # Check consistency of our dbase description. unless( &consistent( \@g_fields, \@bib_types, \@field_types, \%entries_list) ) { print STDERR "Error, dbase description inconsistent. Quitting\n"; } # Find name program was called under. { my @tmp = split(m|/|, $0); $progname = $tmp[-1]; } # Further setup, like connecting to data. } =pod =head2 &gen_hash() I suppose a person could use a Citation Key generator here, however there would be much larger problems with hash collisions for different data since Citation Keys are usually pretty simple. For instance, it isn't hard to see how "Smith79" might collide pretty easily for different articles. One way to generate a hash, could be to just concatenate all of the @required entries. This could be a very long string, certainly it would be of variable length across all the $dbase. Cryptography has a need to "uniquely summarise" a set of data with a constant length string, so this could be used to make all the keys of uniform length and still be unique. It is conceivable, that two articles could appear to be different, just from spelling mistakes in the @required entries. In this case, you probably want a hash collision, so that you can edit the bad data or remove it. I've tried to address both sides of this. The Lingua::EN::Squeeze module is more or less designed to send very concentrated messages to people who have pagers. So, as little extraneous "noise" as is possible, and still be understandable. Different languages for articles, would probably need different language variations of Squeeze. I then ran the squeezed text through a MD5 digester to produce a hexadecimal MD5 checksum. So, it should be midway between being unique across all entries, and being a little insensitive to spelling mistakes. Hash collisions could be reduced by starting to add some of the optional material, but then you need to make sure it only includes optional material common to both, I. As far as Citation Keys goes, a person might want to keep track of what keys a publication has been referenced under, but none of those keys should be used to store the data in a hash. It would be nice if there was multiple Citation Key generators, to use for the various formatting requirements that are found out there. =cut sub gen_hash { my $dbase = shift; my $cache = shift; my $extra = @_ ? shift : undef; my $hash_order = 'required'; my $bib_type; if( exists( $cache->{bib_type} ) && $cache->{bib_type} ) { $bib_type = $cache->{bib_type}; } else { die "No bib_type in cache, can't find @required\n"; } # Look in $cache for data. use Lingua::EN::Squeeze; $SQZ_OPTIMIZE_LEVEL=1; use Digest::MD5 qw(md5_hex); $str = ''; foreach my $field (@{$entries_list{$bib_type}{$hash_order}}) { if( $field =~ /\|/ ) { my @sub_fields = split( /\|/, $field ); foreach my $sub_field (@sub_fields) { if( $sub_field =~ /_$/ ) { my $t_str = join '', sort @{$cache->{$sub_field}}; $str .= $t_str; } else { $str .= $cache->{$sub_field}; } } } else { if( $field =~ /_$/ ) { my $t_str = join '', sort @{$cache->{$field}}; $str .= $t_str; } else { $str .= $cache->{$field}; } } } # We've concatenated all the data as instructed by the $hash_order array # Okay, we have a string. Squeeze it and make MD5 of that. my $squeeze = SqueezeText $str; my $md5_text = md5_hex( $squeeze ); if( exists( $dbase->{$md5_text} ) ) { print "Collision!\n"; my $new = sprintf "%s:%s", $md5_text, $extra; return( $new ) unless( exists( $dbase->{$new} ) ); } else { return( $md5_text ); } return( undef ); } # ====================================================================== # Stuff commented out as not needed, but possibly useful for other stuff # $AddBox->add('LabEntry', # -label => $field, # -textvariable => \$cache->{$field}, # -width => 80, # )->pack(); # # Put in a frame, put a label on the left and an entry on the # # right. Hopefully, this gets us what I want. Why LabEntry # # won't let us pick a constant width for the label field, ?????? # $line_frame{$field} = $AddBox->Frame; # $line_frame{$field}->Label(-text => "$field :", -width => 30 )->pack(-side=>'left'); # $line_frame{$field}->Entry(-textvariable => \$cache->{$field}, -width => 80 )->pack(-side=>'left'); # $line_frame{$field}->pack(); # # Now, we want to delete the cache fields that are in the @ # # array. Or, we do this after all the required/optional/local info # # built up. # foreach my $field (@{$required}) { # if( $field =~ /\|/ ) { # @sub_fields = split( /\|/, $field ); # foreach $sub_field (@sub_fields) { # delete( $cache->{$sub_field} ) if( exists( $cache->{$sub_field} ) ); # } # } else { # delete( $cache->{$field} ) if( exists( $cache->{$field} ) ); # } # } # } else { # Error, bad bib_types data # die "Programmer goofed, sorry\n"; # } # End if( $required ) { ... } =pod =head1 SEE ALSO Visit http://freshmeat.net/ and see the entries for sixpack and allbib. Sixpack in particular is interesting, in that it it tied to BP.pm, a Bibliography Package for perl. While fairly old (1996-7), this package supports importing and exporting many popular formats of bibliographic data. =head1 AUTHOR Gordon Haverland Eperl@materialisations.comE =head1 COPYRIGHT AND LICENSE Copyright 2003 by Gordon Haverland This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut