← Back to branch summary

~ubuntu-branches/ubuntu/trusty/horae/trusty

« back to all changes in this revision

Viewing changes to 0CPAN/STAR-Parser-0.59/bin/query.pl

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2008-02-23 23:13:02 UTC
  • mfrom: (2.1.2 hardy)
  • Revision ID: james.westby@ubuntu.com-20080223231302-mnyyxs3icvrus4ke
Tags: 066-3
Apply patch to athena_parts/misc.pl for compatibility with 
perl-tk 804.28.

Show diffs side-by-side

added added

removed removed

Lines of Context:
0CPAN/STAR-Parser-0.59/bin/query.pl
1
 
#! /usr/local/bin/perl -w 
2
 
 
3
 
##############################
4
 
#                            #
5
 
# query.pl                   #
6
 
#                            #
7
 
# Queries a data structure   # 
8
 
# using the STAR::DataBlock  #
9
 
# module                     # 
10
 
#                            # 
11
 
# Wolfgang Bluhm, SDSC       #
12
 
#                            #
13
 
##############################
14
 
 
15
 
use strict;
16
 
use STAR::DataBlock;
17
 
use STAR::Dictionary;
18
 
 
19
 
my ($s, $i);    
20
 
my ($string, $dict);
21
 
my (@item_data);
22
 
my @selected;
23
 
 
24
 
my $data = STAR::DataBlock->new($ARGV[0]);     # 1-arg constructor
25
 
#
26
 
#this just retrieves an already blessed
27
 
#object, so ok even if it's a Dictionary
28
 
#which inherits from DataBlock
29
 
 
30
 
# could also replace the above one-liner 
31
 
# with the following two lines:
32
 
#
33
 
# my $data = STAR::DataBlock->new;              # no-arg constructor
34
 
# $data = STAR::DataBlock::retrieve($ARGV[0]);
35
 
 
36
 
$dict = 0;
37
 
$dict = 1 if $data->type eq "dictionary";
38
 
 
39
 
if ( $dict ) {
40
 
    print "-"x62,"\n";
41
 
    print "Query dictionary by save block and item name.\n";
42
 
    print "save can be: - (not in a save block),\n";
43
 
    print "             A_CATEGORY (e.g. ENTITY),\n";
44
 
    print "             _an_item   (e.g. _entity.id)\n";
45
 
    print "Capitalization may vary with dictionary.\n";
46
 
    print "Item examples: _dictionary.version      ",
47
 
          "_dictionary_history.revision\n";
48
 
    print "               _category.description    ",
49
 
          "_category_examples.case\n";
50
 
    print "               _item_linked.child_name  ",
51
 
          "_item_description.description\n";
52
 
    print "For items with multiple values: ",
53
 
          "choose index (e.g.: 1, 4-6)\n";
54
 
    print "-"x62,"\n";
55
 
}
56
 
else {
57
 
    print "-"x62,"\n";
58
 
    print "Query ",$data->title," by item name.\n";
59
 
    print "For items with multiple values: ",
60
 
          "choose index (e.g.: 1, 4-6)\n";
61
 
    print "-"x62,"\n";
62
 
}
63
 
 
64
 
do {
65
 
    if ( $dict ) {
66
 
        print "save: ";
67
 
        chomp ($s = <STDIN>);
68
 
    }
69
 
    else {
70
 
        $s = "-";
71
 
    }
72
 
 
73
 
    print "item: ";
74
 
    chomp ($i = <STDIN>);
75
 
    
76
 
    @item_data = $data->get_item_data( -save=>$s, -item=>$i );
77
 
    @selected = ();
78
 
    if ( $#item_data < 0 ) {     # returned null, item doesn't exist
79
 
        print "item $i doesn't exist\n";
80
 
    }
81
 
    else {
82
 
        if ( $#item_data > 0 ) {
83
 
            print "index (range: 0..", $#item_data, "): ";
84
 
            chomp ( $string = <STDIN> );
85
 
            @selected = selection();
86
 
        }
87
 
        else {
88
 
            push @selected, 0;
89
 
        }
90
 
        foreach (@selected) {
91
 
            print "[$_] " unless ( $#item_data == 0 );
92
 
            print $item_data[$_];
93
 
            print "\n";
94
 
        }
95
 
    }
96
 
} while (print("Continue with query? ") && <STDIN> =~ /\by/i);
97
 
 
98
 
 
99
 
sub selection {
100
 
 
101
 
    while ( $string =~ /\d+/ ) {
102
 
        if ( $string =~ /^\D*(\d+)\-(\d+)(.*)/ ) {    #range (e.g. 1-3)
103
 
            push @selected, ($1..$2);
104
 
            $string = $3;
105
 
        }
106
 
        elsif ( $string =~ /^\D*(\d+)(.*)/ ) {        #one number
107
 
            push @selected, $1;
108
 
            $string = $2;
109
 
        }
110
 
    }
111
 
    return @selected;
112
 
}
113
 
 
114
 
=head1 DESCRIPTION
115
 
 
116
 
 This script provides a simple interactive query interface to the data structure
117
 
 of a file of dictionary (.cob files). Query is by item only (for a data file), 
118
 
 or by save block and item (for a dictionary file).
119
 
 
120
 
=head1 USAGE
121
 
 
122
 
 perl query.pl <data.cob or dict.cob>
123
 
 
124
 
=cut
125
 
 
126