lib/A3C/AAIEduHr.pm

package A3C::AAIEduHr;

use strict;
use warnings;

=head1 NAME

AAAIEduHr

=head1 DESCRIPTION

Pull varios stuff from XML at L<http://shema.aaiedu.hr/> and cache it as
JSON on disk

=head1 METHODS

=cut

#use base 'Jifty::Object';

use XML::Rules;
use Data::Dump qw/dump/;
use File::Slurp;
use JSON::XS;

=head2 vocabulary

  valid are A3C::AAIEduHr->vocabulary('hrEdu001'),

  valid are [ '', A3C::AAIEduHr->vocabulary('hrEdu001') ],

=cut

sub vocabulary {
        my $self = shift;

        my $name = shift;
        die "invalid format of name" unless $name =~ /^hrEdu\d\d\d$/;

        my $url = "http://shema.aaiedu.hr/aosi/$name.xml";
        my $xml_path = Jifty::Util->absolute_path( "var/$name.xml" );
        my $data_path = Jifty::Util->absolute_path( "var/$name.js" );

        # sanity cleanup
        unlink $xml_path if -s $xml_path == 0;
        unlink $data_path if -s $data_path == 0;

        # FIXME expire on some other way than rm?
        if ( ! -e $xml_path ) {

                my $ua = LWP::UserAgent->new;
                my $res = $ua->get( $url );

                die "can't get $url status: ", $res->status_line
                        unless $res->is_success;

                write_file( $xml_path, $res->content );
                Jifty->log->info("saved $url into $xml_path");
        }

        die "can't find xml $xml_path: $!" unless -s $xml_path;

        my $data;

        if ( ! -e $data_path ) {
                my $rules = XML::Rules->new(
                stripspaces => 8,
                rules => [
                        _default => sub {
                                my ($tag_name, $tag_hash, $context, $parent_data) = @_;
                                warn "_default $tag_name ",dump( $tag_hash );
                                return;
                        },
                        vocabulary => 'no content',
                        vocabularyentry => sub {
                                die "no key attribute?" unless defined( $_[1]->{key} );
                                my $v = {
                                        display =>      $_[1]->{_content},
                                        value   =>      $_[1]->{key},
                                };
                                # if same, just store key
                                $v = $_[1]->{key} if ( $v->{display} eq $v->{value} );
                                '@' . $_[0] => $v;
                        },
                ]);
                $data = $rules->parsefile( $xml_path )
                        || die "can't parse $xml_path: $!";

                $data = $data->{vocabulary} || die "no vocabulary in data: ", dump( $data );

                write_file( $data_path, encode_json( $data )) || die "can't save into $data_path: $!";
                Jifty->log->info("saved dump into $data_path");
        } else {
                $data = decode_json( read_file( $data_path ) ) || die "can't read $data_path: $!";
                Jifty->log->info("loaded dump from $data_path");
        }

#       warn '## ',ref($data),' = ',dump($data);

        die "data not for for $name" unless $data->{name} eq $name;
        warn "no vocabularyentry for $name from $data_path" unless defined( $data->{vocabularyentry} );

        return @{ $data->{vocabularyentry} } if wantarray;
        return $data->{vocabularyentry};
}

warn "# AAUEduHr loaded\n";

1;
1	dpavlin	88	package A3C::AAIEduHr;
2
3			use strict;
4			use warnings;
5
6			=head1 NAME
7
8			AAAIEduHr
9
10			=head1 DESCRIPTION
11
12			Pull varios stuff from XML at L<http://shema.aaiedu.hr/> and cache it as
13			JSON on disk
14
15	dpavlin	91	=head1 METHODS
16
17	dpavlin	88	=cut
18
19			#use base 'Jifty::Object';
20
21	dpavlin	89	use XML::Rules;
22	dpavlin	88	use Data::Dump qw/dump/;
23			use File::Slurp;
24			use JSON::XS;
25
26	dpavlin	91	=head2 vocabulary
27
28			valid are A3C::AAIEduHr->vocabulary('hrEdu001'),
29
30	dpavlin	93	valid are [ '', A3C::AAIEduHr->vocabulary('hrEdu001') ],
31
32	dpavlin	91	=cut
33
34	dpavlin	89	sub vocabulary {
35	dpavlin	88	my $self = shift;
36
37			my $name = shift;
38			die "invalid format of name" unless $name =~ /^hrEdu\d\d\d$/;
39
40			my $url = "http://shema.aaiedu.hr/aosi/$name.xml";
41			my $xml_path = Jifty::Util->absolute_path( "var/$name.xml" );
42			my $data_path = Jifty::Util->absolute_path( "var/$name.js" );
43
44			# sanity cleanup
45			unlink $xml_path if -s $xml_path == 0;
46			unlink $data_path if -s $data_path == 0;
47
48			# FIXME expire on some other way than rm?
49			if ( ! -e $xml_path ) {
50
51			my $ua = LWP::UserAgent->new;
52			my $res = $ua->get( $url );
53
54			die "can't get $url status: ", $res->status_line
55			unless $res->is_success;
56
57			write_file( $xml_path, $res->content );
58			Jifty->log->info("saved $url into $xml_path");
59			}
60
61			die "can't find xml $xml_path: $!" unless -s $xml_path;
62
63			my $data;
64
65			if ( ! -e $data_path ) {
66	dpavlin	91	my $rules = XML::Rules->new(
67			stripspaces => 8,
68			rules => [
69	dpavlin	89	_default => sub {
70			my ($tag_name, $tag_hash, $context, $parent_data) = @_;
71			warn "_default $tag_name ",dump( $tag_hash );
72			return;
73			},
74			vocabulary => 'no content',
75			vocabularyentry => sub {
76			die "no key attribute?" unless defined( $_[1]->{key} );
77	dpavlin	91	my $v = {
78			display => $_[1]->{_content},
79			value => $_[1]->{key},
80			};
81			# if same, just store key
82			$v = $_[1]->{key} if ( $v->{display} eq $v->{value} );
83			'@' . $_[0] => $v;
84	dpavlin	89	},
85			]);
86			$data = $rules->parsefile( $xml_path )
87			\|\| die "can't parse $xml_path: $!";
88	dpavlin	88
89	dpavlin	89	$data = $data->{vocabulary} \|\| die "no vocabulary in data: ", dump( $data );
90
91	dpavlin	88	write_file( $data_path, encode_json( $data )) \|\| die "can't save into $data_path: $!";
92			Jifty->log->info("saved dump into $data_path");
93			} else {
94			$data = decode_json( read_file( $data_path ) ) \|\| die "can't read $data_path: $!";
95	dpavlin	89	Jifty->log->info("loaded dump from $data_path");
96	dpavlin	88	}
97
98	dpavlin	91	# warn '## ',ref($data),' = ',dump($data);
99	dpavlin	88
100			die "data not for for $name" unless $data->{name} eq $name;
101	dpavlin	89	warn "no vocabularyentry for $name from $data_path" unless defined( $data->{vocabularyentry} );
102	dpavlin	88
103	dpavlin	93	return @{ $data->{vocabularyentry} } if wantarray;
104	dpavlin	89	return $data->{vocabularyentry};
105	dpavlin	88	}
106
107			warn "# AAUEduHr loaded\n";
108
109			1;