annotate Lib/IMPL/Resources.pm @ 14:65a7bb156fb7

Дом модель и схема
author Sergey
date Fri, 04 Sep 2009 16:38:15 +0400
parents 03e58a454b20
children 16ada169ca75
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
1 package IMPL::Resources;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
2 use strict;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
3 use warnings;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
4
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
5 our $Encoding ||= 'utf-8';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
6 our %Files;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
7
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
8 my %Data;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
9
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
10
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
11 foreach my $group (keys %Files) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
12 $Data{$group} = ParseResource($Files{$group});
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
13 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
14
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
15 sub findFile {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
16 my ($fname) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
17
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
18 foreach my $dir (',',@INC) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
19 my $fullfname = "$dir/$fname";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
20 return $fullfname if -f $fullfname;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
21 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
22
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
23 return $fname;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
24 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
25
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
26 sub ParseResource {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
27 my ($fname) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
28
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
29 open my $hRes, "<:encoding($Encoding)", findFile($fname) or die "Failed to open file $fname: $!";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
30
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
31 my %Map;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
32 my $line = 1;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
33 while (<$hRes>) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
34 chomp;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
35 $line ++ and next if /^\s*$/;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
36
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
37 if (/^(\w+)\s*=\s*(.*)$/) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
38 $Map{$1} = $2;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
39 } else {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
40 die "Invalid resource format in $fname at $line";
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
41 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
42 $line ++;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
43 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
44
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
45 return \%Map;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
46 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
47
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
48 sub import {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
49 my ($class,@groups) = @_;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
50 my $caller = caller;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
51 my %merged = map %{$Data{$_} || {} }, @groups;
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
52
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
53 no strict 'refs';
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
54 foreach my $item ( keys %merged ) {
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
55 *{"${caller}::ids_$item"} = sub { sprintf($merged{$item},@_) }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
56 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
57 }
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
58
03e58a454b20 Создан репозитарий
Sergey
parents:
diff changeset
59 1;